Sign Up
Log In
Log In
or
Sign Up
Places
All Projects
Status Monitor
Collapse sidebar
openSUSE:Factory:LegacyX86
casacore
casacore-drop-mirlib.patch
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File casacore-drop-mirlib.patch of Package casacore
From 6461aae425b3123cae293c2b1e9ed588630cbdb8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Offringa?= <offringa@astron.nl> Date: Thu, 2 May 2024 16:31:58 +0200 Subject: [PATCH] Remove mirlib and MIRIADImage This code seems unused and no longer compiles under gcc 14. After these changes, casacore compiles without errors when using gcc 14. --- CMakeLists.txt | 8 images/CMakeLists.txt | 3 images/Images/ImageOpener.cc | 2 images/Images/ImageProxy.cc | 4 images/Images/ImageUtilities2.tcc | 2 images/Images/MIRIADImage.cc | 1125 -------- images/Images/MIRIADImage.h | 303 -- images/Images/test/CMakeLists.txt | 1 images/Images/test/dImageSummary.cc | 5 images/Images/test/tMIRIADImage.cc | 201 - images/Images/test/tMIRIADImage.run | 17 images/apps/image2fits.cc | 2 images/apps/imagecalc.cc | 4 images/apps/imageregrid.cc | 2 images/apps/imageslice.cc | 2 mainpage.dox | 4 mirlib/CMakeLists.txt | 41 mirlib/README | 54 mirlib/bug.c | 367 -- mirlib/dio.c | 346 -- mirlib/headio.c | 839 ----- mirlib/hio.c | 1526 ---------- mirlib/hio.h | 48 mirlib/io.h | 56 mirlib/key.c | 968 ------ mirlib/maskio.c | 450 --- mirlib/maxdimc.h | 32 mirlib/miriad.h | 391 -- mirlib/pack.c | 643 ---- mirlib/scrio.c | 201 - mirlib/sysdep.h | 184 - mirlib/uvio.c | 5056 ------------------------------------ mirlib/xyio.c | 494 --- mirlib/xyzio.c | 2034 -------------- 34 files changed, 7 insertions(+), 15408 deletions(-) delete mode 120000 casacore delete mode 100644 images/Images/MIRIADImage.cc delete mode 100644 images/Images/MIRIADImage.h delete mode 100644 images/Images/test/tMIRIADImage.cc delete mode 100755 images/Images/test/tMIRIADImage.run delete mode 100644 mirlib/CMakeLists.txt delete mode 100644 mirlib/README delete mode 100644 mirlib/bug.c delete mode 100644 mirlib/dio.c delete mode 100644 mirlib/headio.c delete mode 100644 mirlib/hio.c delete mode 100644 mirlib/hio.h delete mode 100644 mirlib/io.h delete mode 100644 mirlib/key.c delete mode 100644 mirlib/maskio.c delete mode 100644 mirlib/maxdimc.h delete mode 100644 mirlib/miriad.h delete mode 100644 mirlib/pack.c delete mode 100644 mirlib/scrio.c delete mode 100644 mirlib/sysdep.h delete mode 100644 mirlib/uvio.c delete mode 100644 mirlib/xyio.c delete mode 100644 mirlib/xyzio.c Index: casacore-3.5.0/CMakeLists.txt =================================================================== --- casacore-3.5.0.orig/CMakeLists.txt +++ casacore-3.5.0/CMakeLists.txt @@ -255,7 +255,7 @@ if (NOT ${MODULE} STREQUAL "casa") set (_usefits YES) endif() if (${MODULE} STREQUAL "images" OR ${MODULE} STREQUAL "all") - set (_modules2 ${_modules2} lattices mirlib coordinates images) + set (_modules2 ${_modules2} lattices coordinates images) set (_usewcs YES) set (_usefits YES) endif() @@ -538,9 +538,9 @@ foreach (module ${_modules}) endif (PYTHON_SHARED_LINKER_FLAGS AND ${module} STREQUAL python) endif (CASA_BUILD) if (APPLE) - if (${module} STREQUAL scimath_f OR ${module} STREQUAL fits OR ${module} STREQUAL mirlib OR ${module} STREQUAL coordinates) + if (${module} STREQUAL scimath_f OR ${module} STREQUAL fits OR ${module} STREQUAL coordinates) set_target_properties(casa_${module} PROPERTIES LINK_FLAGS -single_module) - endif (${module} STREQUAL scimath_f OR ${module} STREQUAL fits OR ${module} STREQUAL mirlib OR ${module} STREQUAL coordinates) + endif (${module} STREQUAL scimath_f OR ${module} STREQUAL fits OR ${module} STREQUAL coordinates) endif (APPLE) set(PRIVATE_LIBS "${PRIVATE_LIBS} -lcasa_${module}") endforeach (module) @@ -621,7 +621,7 @@ endif (BUILD_PYTHON3) # - measures (scimath,scimath_f,measures,meas) # - ms (ms,derivedmscal) # or msfits (fits,ms,msfits,derivedmscal) -# or images (fits,lattices,mirlib,coordinates,images) +# or images (fits,lattices,coordinates,images) # - all # # List of possibly used external packages and where Index: casacore-3.5.0/images/CMakeLists.txt =================================================================== --- casacore-3.5.0.orig/images/CMakeLists.txt +++ casacore-3.5.0/images/CMakeLists.txt @@ -56,7 +56,6 @@ Images/ImageOpener.cc Images/ImageProxy.cc Images/ImageUtilities.cc Images/LELImageCoord.cc -Images/MIRIADImage.cc Images/MaskSpecifier.cc Images/PagedImage2.cc ${BISON_ImageExprGram_OUTPUTS} @@ -66,7 +65,6 @@ ${FLEX_ImageExprGram_OUTPUTS} target_link_libraries ( casa_images casa_coordinates -casa_mirlib casa_lattices ${CASACORE_ARCH_LIBS} ) @@ -123,7 +121,6 @@ Images/ImageSummary.tcc Images/ImageUtilities.h Images/ImageUtilities2.tcc Images/LELImageCoord.h -Images/MIRIADImage.h Images/MaskSpecifier.h Images/PagedImage.h Images/PagedImage.tcc Index: casacore-3.5.0/images/Images/ImageOpener.cc =================================================================== --- casacore-3.5.0.orig/images/Images/ImageOpener.cc +++ casacore-3.5.0/images/Images/ImageOpener.cc @@ -36,7 +36,6 @@ #include <casacore/images/Images/ImageExpr.h> #include <casacore/images/Images/ImageExprParse.h> #include <casacore/images/Images/FITSImage.h> -#include <casacore/images/Images/MIRIADImage.h> #include <casacore/lattices/LEL/LatticeExprNode.h> #include <casacore/casa/HDF5/HDF5File.h> #include <casacore/casa/IO/ArrayIO.h> @@ -276,7 +275,6 @@ LatticeBase* ImageOpener::openImage (con return openImageExpr (fileName); } FITSImage::registerOpenFunction(); - MIRIADImage::registerOpenFunction(); // Try to open a foreign image. if (theirOpenFuncMap.find(type) == theirOpenFuncMap.end()) { return 0; Index: casacore-3.5.0/images/Images/ImageProxy.cc =================================================================== --- casacore-3.5.0.orig/images/Images/ImageProxy.cc +++ casacore-3.5.0/images/Images/ImageProxy.cc @@ -43,7 +43,6 @@ #include <casacore/images/Images/PagedImage.h> #include <casacore/images/Images/HDF5Image.h> #include <casacore/images/Images/FITSImage.h> -#include <casacore/images/Images/MIRIADImage.h> #include <casacore/images/Images/ImageUtilities.h> #include <casacore/lattices/LEL/LatticeExprNode.h> #include <casacore/coordinates/Coordinates/CoordinateSystem.h> @@ -91,9 +90,8 @@ namespace casacore { //# name space casa itsCoordSys (0), itsAttrHandler (0) { - // Register the functions to create a FITSImage or MIRIADImage object. + // Register the functions to create a FITSImage object. FITSImage::registerOpenFunction(); - MIRIADImage::registerOpenFunction(); LatticeBase* lattice = openImage (name, mask, images); setup (lattice); } Index: casacore-3.5.0/images/Images/ImageUtilities2.tcc =================================================================== --- casacore-3.5.0.orig/images/Images/ImageUtilities2.tcc +++ casacore-3.5.0/images/Images/ImageUtilities2.tcc @@ -39,7 +39,6 @@ #include <casacore/images/Images/FITSImage.h> #include <casacore/images/Images/ImageInterface.h> #include <casacore/images/Images/ImageOpener.h> -#include <casacore/images/Images/MIRIADImage.h> #include <casacore/images/Images/PagedImage.h> #include <casacore/images/Images/SubImage.h> #include <casacore/images/Images/TempImage.h> @@ -264,7 +263,6 @@ template <typename T> void ImageUtilitie "File '" + fileName + "' does not exist" ); FITSImage::registerOpenFunction(); - MIRIADImage::registerOpenFunction(); LatticeBase* lattPtr = ImageOpener::openImage (fileName); ThrowIf( ! lattPtr, Index: casacore-3.5.0/images/Images/test/CMakeLists.txt =================================================================== --- casacore-3.5.0.orig/images/Images/test/CMakeLists.txt +++ casacore-3.5.0/images/Images/test/CMakeLists.txt @@ -64,7 +64,6 @@ tImageStatistics tImageStatistics2 tImageUtilities tLELSpectralIndex -tMIRIADImage tPagedImage tPagedImage2 tRebinImage Index: casacore-3.5.0/images/Images/test/dImageSummary.cc =================================================================== --- casacore-3.5.0.orig/images/Images/test/dImageSummary.cc +++ casacore-3.5.0/images/Images/test/dImageSummary.cc @@ -36,7 +36,6 @@ #include <casacore/images/Images/ImageSummary.h> #include <casacore/images/Images/PagedImage.h> #include <casacore/images/Images/FITSImage.h> -#include <casacore/images/Images/MIRIADImage.h> #include <casacore/measures/Measures/MDoppler.h> #include <casacore/casa/namespace.h> @@ -89,10 +88,6 @@ try { FITSImage im(in); ImageSummary<Float> header(im); header.list(os, doppler); - } else if (imageType==ImageOpener::MIRIAD) { - MIRIADImage im(in); - ImageSummary<Float> header(im); - header.list(os, doppler); } else { os << "Unrecognized image type" << LogIO::EXCEPTION; } Index: casacore-3.5.0/images/Images/test/tMIRIADImage.run =================================================================== --- casacore-3.5.0.orig/images/Images/test/tMIRIADImage.run +++ /dev/null @@ -1,17 +0,0 @@ -#!/bin/sh - -if [ ${#AIPSPATH} = 0 ] -then - echo "UNTESTED: tMIRIADImage (AIPSPATH not defined)" - exit 3 -fi - -DATAFILE=`echo $AIPSPATH | awk '{print $1}'`/data/demo/Images/imagetestimage.mir - -if [ -f $DATAFILE ] -then - $casa_checktool ./tMIRIADImage in=$DATAFILE -else - echo "UNTESTED: tMIRIADImage, could not find test data file " $DATAFILE - exit 3 -fi Index: casacore-3.5.0/images/apps/image2fits.cc =================================================================== --- casacore-3.5.0.orig/images/apps/image2fits.cc +++ casacore-3.5.0/images/apps/image2fits.cc @@ -33,7 +33,6 @@ #include <casacore/images/Images/ImageExprParse.h> #include <casacore/images/Images/ImageFITSConverter.h> #include <casacore/images/Images/FITSImage.h> -#include <casacore/images/Images/MIRIADImage.h> #include <casacore/casa/Exceptions/Error.h> #include <casacore/casa/iostream.h> @@ -44,7 +43,6 @@ int main (int argc, const char* argv[]) try { // Register the FITS and Miriad image types. casacore::FITSImage::registerOpenFunction(); - casacore::MIRIADImage::registerOpenFunction(); // enable input in no-prompt mode Input inputs(1); Index: casacore-3.5.0/images/apps/imagecalc.cc =================================================================== --- casacore-3.5.0.orig/images/apps/imagecalc.cc +++ casacore-3.5.0/images/apps/imagecalc.cc @@ -29,7 +29,6 @@ #include <casacore/images/Images/PagedImage.h> #include <casacore/images/Images/HDF5Image.h> #include <casacore/images/Images/FITSImage.h> -#include <casacore/images/Images/MIRIADImage.h> #include <casacore/images/Images/ImageProxy.h> #include <casacore/images/Images/ImageExpr.h> #include <casacore/images/Images/ImageExprParse.h> @@ -39,9 +38,8 @@ using namespace casacore; int main(int argc, const char* argv[]) { try { - // Register the FITS and Miriad image types. + // Register the FITS image types. casacore::FITSImage::registerOpenFunction(); - casacore::MIRIADImage::registerOpenFunction(); // Read the input parameters. Input inputs(1); Index: casacore-3.5.0/images/apps/imageregrid.cc =================================================================== --- casacore-3.5.0.orig/images/apps/imageregrid.cc +++ casacore-3.5.0/images/apps/imageregrid.cc @@ -37,7 +37,6 @@ #include <casacore/images/Images/ImageInterface.h> #include <casacore/images/Images/ImageOpener.h> #include <casacore/images/Images/FITSImage.h> -#include <casacore/images/Images/MIRIADImage.h> #include <casacore/images/Images/HDF5Image.h> #include <casacore/images/Images/ImageUtilities.h> #include <casacore/images/Images/ImageRegrid.h> @@ -94,7 +93,6 @@ int main(int argc, const char* argv[]) { const String interpolation = inputs.getString("interpolation"); FITSImage::registerOpenFunction(); - MIRIADImage::registerOpenFunction(); LatticeBase* pLatt = ImageOpener::openImage(in); ImageInterface<Float>* pImage = dynamic_cast<ImageInterface<Float>*>(pLatt); if (!pImage) { Index: casacore-3.5.0/images/apps/imageslice.cc =================================================================== --- casacore-3.5.0.orig/images/apps/imageslice.cc +++ casacore-3.5.0/images/apps/imageslice.cc @@ -32,7 +32,6 @@ #include <casacore/images/Images/ImageOpener.h> #include <casacore/images/Images/FITSImage.h> -#include <casacore/images/Images/MIRIADImage.h> #include <casacore/images/Images/SubImage.h> #include <casacore/images/Images/ImageFITSConverter.h> #include <casacore/images/Images/ImageUtilities.h> @@ -64,7 +63,6 @@ int main(int argc, const char* argv[]) { const Block<Int> outregion = inputs.getIntArray("outregion"); FITSImage::registerOpenFunction(); - MIRIADImage::registerOpenFunction(); LatticeBase* pLatt = ImageOpener::openImage(in); ImageInterface<Float>* pImage = dynamic_cast<ImageInterface<Float>*>(pLatt); if (!pImage) { Index: casacore-3.5.0/mainpage.dox =================================================================== --- casacore-3.5.0.orig/mainpage.dox +++ casacore-3.5.0/mainpage.dox @@ -224,15 +224,13 @@ namespace casacore { /// <tr> /// <td><a href="group__images.html">images</a></td> /// <td>lattices coordinates fits measures tables scimath casa -/// mirlib wcslib cfitsio</td> +/// wcslib cfitsio</td> /// </tr> /// <tr> /// <td><a href="group__python.html">python</a></td> /// <td>casa boost-python python numpy</td> /// </tr> /// </table> -/// <a href="http://www.atnf.csiro.au/computing/software/miriad">mirlib</a> -/// is distributed and built as part of Casacore. /// <a href="http://www.atnf.csiro.au/~mcalabre/WCS">wcslib</a> and /// <a href="http://heasarc.gsfc.nasa.gov/docs/software/fitsio/fitsio.html">cfitsio</a> /// are external packages that have to be installed before building all of Casacore. Index: casacore-3.5.0/mirlib/CMakeLists.txt =================================================================== --- casacore-3.5.0.orig/mirlib/CMakeLists.txt +++ /dev/null @@ -1,41 +0,0 @@ -# -# CASA Mirlib -# - -add_library ( -casa_mirlib -bug.c -dio.c -headio.c -hio.c -key.c -maskio.c -pack.c -scrio.c -uvio.c -xyio.c -xyzio.c -) - - -target_link_libraries (casa_mirlib casa_casa ${CASACORE_ARCH_LIBS}) - -install ( -TARGETS casa_mirlib -RUNTIME DESTINATION bin -LIBRARY DESTINATION lib${LIB_SUFFIX} -ARCHIVE DESTINATION lib${LIB_SUFFIX} -LIBRARY PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE -) - -install ( -FILES -hio.h -io.h -maxdimc.h -miriad.h -sysdep.h -DESTINATION -include/casacore/mirlib -) - Index: casacore-3.5.0/mirlib/bug.c =================================================================== --- casacore-3.5.0.orig/mirlib/bug.c +++ /dev/null @@ -1,367 +0,0 @@ -/************************************************************************/ -/* */ -/* This handles errors and can abort your program. */ -/* */ -/* History: */ -/* rjs,mjs ???? Very mixed history. Created, destroyed, rewritten.*/ -/* rjs 26aug93 Call habort_c. */ -/* rjs 14jul98 Add a caste operation in errmsg_c, to attempt */ -/* to appease some compilers. */ -/* pjt 23sep01 darwin */ -/* pjt 4dec01 bypass fatal errors (for alien clients) if req'd */ -/* through the new bugrecover_c() routine */ -/* pjt 17jun02 prototypes for MIR4 */ -/* pjt/ram 5dec03 using strerror() for unix */ -/* pjt 1jan05 bugv_c: finally, a real stdargs version!!! */ -/* though cannot be exported to Fortran */ -/* pjt 26mar07 bugmessage_c: retrieve last fatal bug message */ -/* pjt 27mar07 bugseverity_c: also overhauled bug recovery */ -/* and removed VMS specific code */ -/* pjt 17may07 removed old-non ANSI declaration */ -/* pjt 5dec07 add Name to bug output - why took us so long? */ -/* pkgw 6mar08 declare Name as static to prevent symbol clashes */ -/* dhem 12feb09 added hooks to allow alien clients to completely */ -/* override the default bug handler */ -/* pkgw 14dec11 Make errmsg_c public for use in uvio.c */ -/************************************************************************/ - -#if defined(HAVE_CONFIG_H) && HAVE_CONFIG_H -#include "config.h" -#endif - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <stdarg.h> -#include "miriad.h" - -char *errmsg_c(int n); -static int handle_bug_cleanup(int d, char s, Const char *m); - -static char *Name = NULL; /* a slot to store the program name */ -int reentrant=0; /* keep track of state */ - -/* helper definitions for function pointers */ -typedef void (*bug_cleanup_proc)(void); -typedef void (*bug_handler_proc)(char s, Const char *m); - -/* external bug cleanup handler, if any */ -/* only used by internal bug handler */ -static bug_cleanup_proc bug_cleanup=NULL; - -/* bug handler function pointer */ -static bug_handler_proc bug_handler=NULL; - -/* forward declaration */ -static void default_bug_handler_c(char s,Const char *m); - -static char *bug_message=0; /* last message */ -static char bug_severity=0; /* last severity level (i,w,e or f) */ - - -#define MAXMSG 256 -static char msg[MAXMSG]; /* formatted message for bugv_c() */ - - -/************************************************************************/ -char *bugmessage_c(void) -/** bugmessage_c -- return last fatal error message string */ -/*& pjt */ -/*: error-handling */ -/*+ - This routine does not have a FORTRAN counterpart, as it is normally - only called by C clients who have set their own error handler if - for some reason they don't like the MIRIAD one (e.g. C++ or java - exceptions, or NEMO's error handler. This way the bugrecover handler - can call this routine to retrieve the last fatal error message. - - bugrecover_c(my_handler); - - void my_handler(void) { - char *m = bugmessage_c(); - printf("RECOVERED: %s\n",m); - } - .. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - return bug_message; -} - -/************************************************************************/ -char bugseverity_c(void) -/** bugseverity_c -- return last severity level */ -/*& pjt */ -/*: error-handling */ -/*+ - This routine does not have a FORTRAN counterpart, as it is normally - only called by C clients who have set their own error handler if - for some reason they don't like the MIRIAD one (e.g. C++ or java - exceptions, or NEMO's error handler. This way the bugrecover handler - can call this routine to retrieve the last severity level - - bugrecover_c(my_handler); - - void my_handler(void) { - char s = bugseverity_c(); - char *m = bugmessage_c(); - printf("RECOVERED: (%c) %s\n",s,m); - if (s=='f') exit(1); - } - .. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - return bug_severity; -} - -/************************************************************************/ -void bughandler_c(bug_handler_proc new_bug_handler) -/** bughandler_c -- specify the bug handler callback function */ -/*& dhem */ -/*: error-handling */ -/*+ - This routine does not have a FORTRAN counterpart, as it is normally - only called by C clients who need to set their own error handler if - for some reason they don't like the MIRIAD one (e.g. C++ or java - exceptions, or NEMO's error handler, or scripting languages such as - Ruby and Python that provide their own exception handling - capabilities). - - Absolutely nothing is done before or after the bug handler is - called. This is even more of an override than bugrecover_c - provides because on fatal errors, habort_c is called before the bug - cleanup routine installed by bugrecover_c is called. Another - difference is that bug_message and bug_severity are not set; - instead the severity and message are passed as parameters to the - bug handler callback function.. - - If NULL is passed as the new_bug_handler parameter, the default bug - handler will be reinstated. - - Example of usage: - - void my_bug_handler(char s, onst char *m) { - .... - } - - - .. - bughandler_c(my_bug_handler); - .. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - bug_handler = new_bug_handler; - if (bug_message) free(bug_message); - bug_message = strdup("no bug_message has been set yet"); -} - -/************************************************************************/ -void bugrecover_c(void (*cl)(void)) -/** bugrecover_c -- bypass fatal bug calls for alien clients */ -/*& pjt */ -/*: error-handling */ -/*+ - This routine does not have a FORTRAN counterpart, as it is normally - only called by C clients who need to set their own error handler if - for some reason they don't like the MIRIAD one (e.g. C++ or java - exceptions, or NEMO's error handler - Example of usage: - - void my_bug_cleanup(void) { - .... - } - - - .. - bugrecover_c(my_bug_cleanup); - .. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - bug_cleanup = cl; - if (bug_message) free(bug_message); - bug_message = strdup("no bug_message has been set yet"); -} - -/************************************************************************/ -void buglabel_c(Const char *name) -/** buglabel -- Give the "program name" to be used as a label in messages. */ -/*& pjt */ -/*: error-handling */ -/*+ FORTRAN call sequence: - subroutine buglabel(name) - - implicit none - character name*(*) - - Give the name that is to be used as a label in error messages. Usually - this is the program name and should be set by the user interface. - - Input: - name The name to be given as a label in error messages. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - if(Name != NULL)free(Name); - Name = malloc(strlen(name)+1); - strcpy(Name,name); -} -/************************************************************************/ -void bug_c(char s,Const char *m) -/** bug -- Issue an error message, given by the caller. */ -/*& pjt */ -/*: error-handling */ -/*+ FORTRAN call sequence: - subroutine bug(severity,message) - - implicit none - character severity*1 - character message*(*) - - Output the error message given by the caller, and abort if needed. - - Input: - severity Error severity. Can be one of 'i', 'w', 'e' or 'f' - for "informational", "warning", "error", or "fatal" - message The error message text. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - if(bug_handler == NULL) { - bug_handler = default_bug_handler_c; - } - - bug_handler(s, m); -} -/************************************************************************/ -static void default_bug_handler_c(char s, Const char *m) -/* - Default bug handler. -------------------------------------------------------------------------*/ -{ - char *p; - int doabort; - - doabort = 0; - if (s == 'i' || s == 'I') p = "Informational"; - else if (s == 'w' || s == 'W') p = "Warning"; - else if (s == 'e' || s == 'E') p = "Error"; - else {doabort = 1; p = "Fatal Error"; } - - if (!bug_cleanup) - { - if ( Name == NULL ) - buglabel_c("(NOT SET)"); - fprintf(stderr,"### %s [%s]: %s\n",p,Name,m); - } - - if(doabort){ - reentrant = !reentrant; - if(reentrant)habort_c(); - if (!handle_bug_cleanup(doabort,s,m)) - exit(1); - } else - handle_bug_cleanup(doabort,s,m); -} -/************************************************************************/ -void bugv_c(char s,Const char *m, ...) -/** bugv_c -- Issue a dynamic error message, given by the caller. */ -/*& pjt */ -/*: error-handling */ -/*+ C call sequence: - bugv_c(severity,message,....) - - Output the error message given by the caller, and abort if needed. - Note this routine has no counterpart in FORTRAN. - - Input: - severity Error severity character. - Can be one of 'i', 'w', 'e' or 'f' - for "informational", "warning", "error", or "fatal" - message The error message string, can contain %-printf style - directives, as used by the following arguments. - ... Optional argument, in the printf() style */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - va_list ap; - - va_start(ap,m); - vsnprintf(msg,MAXMSG,m,ap); - msg[MAXMSG-1] = '\0'; /* backstop */ - va_end(ap); - - bug_c(s, msg); -} - -/************************************************************************/ -void bugno_c(char s,int n) -/** bugno -- Issue an error message, given a system error number. */ -/*& pjt */ -/*: error-handling */ -/*+ FORTRAN call sequence: - subroutine bugno(severity,errno) - - implicit none - character severity*1 - integer errno - - Output the error message associated with a particular error number. - - Input: - severity Error severity. Can be one of 'i', 'w', 'e' or 'f' - for "informational", "warning", "error", or "fatal" - errno host error number. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - if (n == -1)bug_c(s,"End of file detected"); - else bug_c(s,errmsg_c(n)); -} -/************************************************************************/ -char *errmsg_c(int n) -/* - Return the error message associated with some error number. -------------------------------------------------------------------------*/ -{ -/* check for linux leaves this compat with old style build - * this should be removed in favor of HAVE_STRERROR once - * is only supported using autotools/configure - */ -#if defined(linux) || (defined(HAVE_STRERROR) && HAVE_STRERROR) - /* new POSIX.1 style, 20 years old now... (1988) */ - if(n == -1) - return "End of file detected"; - return strerror(n); -#else - /* very old style code -- stdio.h is supposed to supply this */ -# if 0 - extern int sys_nerr; - extern char *sys_errlist[]; -# endif - if(n > 0 && n <= sys_nerr)return((char *)sys_errlist[n]); - else { - sprintf(msg,"Unknown error with number %d detected.",n); - return msg; - } -#endif -} -/************************************************************************/ -static int handle_bug_cleanup(int doabort, char s, Const char *m) -/* - Handle cleaning up a bug -------------------------------------------------------------------------*/ -{ - if (bug_cleanup) { - if (bug_message) free(bug_message); - bug_message = strdup(m); /* save last message */ - bug_severity = s; /* save last severity */ - (*bug_cleanup)(); /* call handler ; this may exit */ - if (doabort) /* if it got here, handler didn't exit */ - fprintf(stderr,"### handle_bug_cleanup: WARNING: code should not come here\n"); - return 1; - } - return 0; -} Index: casacore-3.5.0/mirlib/dio.c =================================================================== --- casacore-3.5.0.orig/mirlib/dio.c +++ /dev/null @@ -1,346 +0,0 @@ -/************************************************************************/ -/* DIO -- Disk I/O routines for a Unix Enviromment. */ -/* */ -/* Makes calls to the UNIX I/O and directory searching routines. */ -/* All of these get implemented in a pretty straight forward way. */ -/* */ -/* Portability Notes: */ -/* These routines are intended to run on BSD UNIX and UNICOS. No */ -/* attempt has been made to make them any more portable than this. */ -/* There are some minor differences between the two, which are */ -/* selectively compiled depending if BSD is defined. */ -/* 1. The mkdir system service is not present on some systems, and */ -/* may require superuser priveleges to implement using mknod. */ -/* In this case, use 'popen("mkdir ...","r",...)' */ -/* 2. The Berkeley directory searching routines are used. These */ -/* can be relatively simply implemented in other UNIX's. */ -/* */ -/* History: */ -/* dakr-ages rjs Original version adapted from werong. */ -/* 31-oct-89 pjt _trace_ added as defined() option, errno */ -/* -nov-89 rjs dexpand_c routine */ -/* 6-dec-89 pjt extended bug call */ -/* 26-jan-90 rjs Reincluded <stdio.h>, which is needed by Unicos. */ -/* 27-apr-90 rjs Added ddelete_c routine. */ -/* 26-aug-93 rjs Added hrmdir. */ -/* 5-nov-94 rjs Improve POSIX compliance. */ -/* 26-Oct-95 rjs Honour TMPDIR environment variable, if set. */ -/* 10-Jan-96 rjs Make sure scratch file names are unique. */ -/* 17-jun-02 pjt MIR4 changes, and proper prototypes */ -/* 5-nov-04 jwr Changed a few size_t to ssize_t or off_t */ -/* 3-jan-05 pjt ssize casting to appease the compiler */ -/* use SSIZE_MAX to protect from bad casting ? */ -/* 2-mar-05 pjt template->templat for C++, just in case */ -/* 02-dec-11 pkgw Fix semantics of I/O syscalls in dread, dwrite */ -/************************************************************************/ - -#if defined(HAVE_CONFIG_H) && HAVE_CONFIG_H -#include "config.h" -#endif - -#include <stddef.h> -#include <stdlib.h> -#include <string.h> -#include <sys/types.h> -#include <sys/stat.h> -#include <limits.h> -#include <unistd.h> -#include <fcntl.h> -#include <dirent.h> -#define direct dirent -#include <stdio.h> -#include <errno.h> - -#include "miriad.h" - -#define MAXPATH 128 - -#ifndef NULL -# define NULL 0 -#endif - -#define Malloc(x) malloc((unsigned)(x)) -#define Strcat (void)strcat -#define Strcpy (void)strcpy -#define Lseek(a,b,c) (off_t)lseek(a,(off_t)(b),c) - -struct dent { - char path[MAXPATH]; - DIR *dir; -}; -/************************************************************************/ -void ddelete_c(char *path,int *iostat) -/* - This deletes a file, and returns an i/o status. -------------------------------------------------------------------------*/ -{ - *iostat = ( unlink(path) ? errno : 0 ); -} -/************************************************************************/ -void dtrans_c(char *inpath,char *outpath,int *iostat) -/* - Translate a directory spec into the local format. On a UNIX machine, - this merely involves adding a slash to the end of the name. - - Input: - inpath Input directory spec. - Output: - outpath Output directory spec. - iostat Error return. -------------------------------------------------------------------------*/ -{ - char *s; - - *iostat = 0; - Strcpy(outpath,inpath); - s = outpath + strlen(outpath) - 1; - if(*s != '/')Strcat(outpath,"/"); -} -/************************************************************************/ -void dmkdir_c(char *path,int *iostat) -/* - Create a directory. This might be a privileged operation on some systems, - in which case dmkdir_c will have to work by using popen(3) and mkdir(1). - - Input: - path Name of directory to create. This will usually have a - trailing slash, which needs to be trimmed off. - Output: - iostat Errror status. -------------------------------------------------------------------------*/ -{ - char Path[MAXPATH],*s; - -/* Usually the path will end in a '/', so get rid of it. */ - - Strcpy(Path,path); - s = Path + strlen(Path) - 1; - if(*s == '/')*s = 0; - - *iostat = 0; - if(mkdir(Path,0777) < 0) *iostat = errno; -} -/************************************************************************/ -void drmdir_c(char *path,int *iostat) -/* - Delete a directory. This might be a privileged operation on some systems, - in which case drmdir_c will have to work by using popen(3) and rmdir(1). - - Input: - path Name of directory to remove. This will usually have a - trailing slash, which needs to be trimmed off. - Output: - iostat Errror status. -------------------------------------------------------------------------*/ -{ - char Path[MAXPATH],*s; - -/* Usually the path will end in a '/', so get rid of it. */ - - Strcpy(Path,path); - s = Path + strlen(Path) - 1; - if(*s == '/')*s = 0; - - *iostat = 0; - if(rmdir(Path) < 0) *iostat = errno; -} -/************************************************************************/ -void dopen_c(int *fd,char *name,char *status,off_t *size,int *iostat) -/* - Open a file. - Input: - name Name of file to create (in host format). - status Either "read", "write", "append" or "scratch". - "scratch" files are using $TMPDIR, if present, else current. - - Output: - fd File descriptor. - size Size of file. - iostat I/O status. - -------------------------------------------------------------------------*/ -{ - int is_scratch,pid,flags=0; - char *s,sname[MAXPATH]; - - is_scratch = *iostat = 0; - s = name; - - if (!strcmp(status,"read")) flags = O_RDONLY; - else if(!strcmp(status,"write")) flags = O_CREAT|O_TRUNC|O_RDWR; - else if(!strcmp(status,"append")) flags = O_CREAT|O_RDWR; - else if(!strcmp(status,"scratch")){ - flags = O_CREAT|O_TRUNC|O_RDWR; - is_scratch = 1; - s = getenv("TMPDIR"); - pid = getpid(); - if(s != NULL)sprintf(sname,"%s/%s.%d",s,name,pid); - else sprintf(sname,"%s.%d",name,pid); - s = sname; - } else bug_c('f',"dopen_c: Unrecognised status"); -#ifdef O_LARGEFILE - flags |= O_LARGEFILE; -#endif - if((*fd = open(s,flags,0644)) < 0){*iostat = errno; return;} - *size = Lseek(*fd,0,SEEK_END); - -/* If its a scratch file, unlink it now, so that the file will disappear - when it is closed (or this program crashes). */ - - if(is_scratch)(void)unlink(s); -} -/************************************************************************/ -void dclose_c(int fd,int *iostat) -/* - This subroutine does unbelievably complex stuff. -------------------------------------------------------------------------*/ -{ - *iostat = ( close(fd) < 0 ? errno : 0 ); -} -/************************************************************************/ -void dread_c(int fd, char *buffer,off_t offset,size_t length,int *iostat) -/* - Read from a file. -------------------------------------------------------------------------*/ -{ - ssize_t nread; -#ifdef debug - if (length >= SSIZE_MAX) bugv_c('f',"dread_c: possible incomplete read"); -#endif - if(Lseek(fd,offset,SEEK_SET) < 0) { *iostat = errno; return; } - - while (length) { - nread = read(fd,buffer,length); - if(nread < 0) { - if(errno == EINTR) - nread = 0; /* should reattempt the system call identically */ - else { - *iostat = errno; - return; - } - } else if(nread == 0) { - /* unexpected EOF -- no good errno code for this */ - *iostat = EIO; - return; - } - length -= nread; - } -} -/************************************************************************/ -void dwrite_c(int fd, char *buffer,off_t offset,size_t length,int *iostat) -/* - Write to a file. -------------------------------------------------------------------------*/ -{ - ssize_t nwrite; -#ifdef debug - if (length >= SSIZE_MAX) bugv_c('f',"dwrite_c: possible incomplete write"); -#endif - if(Lseek(fd,offset,SEEK_SET) < 0) { *iostat = errno; return; } - - while (length) { - nwrite = write(fd,buffer,length); - if(nwrite < 0) { - if(errno == EINTR) - nwrite = 0; /* should reattempt the system call identically */ - else { - *iostat = errno; - return; - } - } - length -= nwrite; - } -} -/************************************************************************/ -/*ARGSUSED*/ -void dwait_c(int fd,int *iostat) -/* - This nominally waits for i/o to a file to finish. Things work synchronously - in UNIX. -------------------------------------------------------------------------*/ -{ - *iostat = 0; -} -/************************************************************************/ -int dexpand_c(char *templat,char *output,int length) -/* - This expands wildcards, matching them with files. - - Input: - templat The input character string, containing the wildcards. - length The length of the output buffer. - Output: - output All the files matching "template". Filenames are separated - by commas. -------------------------------------------------------------------------*/ -{ - FILE *fd; - char line[MAXPATH],*s; - int l; - - Strcpy(line,"echo "); - Strcat(line,templat); - fd = popen(line,"r"); - if(fd == NULL) return(-1); - s = output; - while(fgets(s,length,fd)){ - l = strlen(s); - if( length-l <= 1 ){(void)pclose(fd); return(-1);} - *(s+l-1) = ','; - s += l; - length -= l; - } - if(s != output) *--s = 0; - (void)pclose(fd); - return(s-output); -} -/************************************************************************/ -void dopendir_c(char **contxt,char *path) -/* - Open a directory, and prepare to read from it. -------------------------------------------------------------------------*/ -{ - struct dent *d; - - *contxt = Malloc(sizeof(struct dent)); - d = (struct dent *)*contxt; - Strcpy(d->path,path); - d->dir = opendir(path); -} -/************************************************************************/ -void dclosedir_c(char *contxt) -/* - Close a directory. -------------------------------------------------------------------------*/ -{ - struct dent *d; - d = (struct dent *)contxt; - (void)closedir(d->dir); - free(contxt); -} -/************************************************************************/ -/*ARGSUSED*/ -void dreaddir_c(char *contxt,char *path,int length) -/* - Read a directory entry. -------------------------------------------------------------------------*/ -{ - struct dent *d; - struct direct *dp; - struct stat buf; - char npath[MAXPATH]; - - d = (struct dent *)contxt; - - do dp = readdir(d->dir); - while(dp != NULL && (!strcmp(dp->d_name,".") || !strcmp(dp->d_name,".."))); - - if(dp == NULL) - *path = 0; - else{ - Strcpy(path,dp->d_name); - Strcpy(npath,d->path); Strcat(npath,path); - (void)stat(npath,&buf); - if(S_IFDIR & buf.st_mode)Strcat(path,"/"); - } -} Index: casacore-3.5.0/mirlib/headio.c =================================================================== --- casacore-3.5.0.orig/mirlib/headio.c +++ /dev/null @@ -1,839 +0,0 @@ -/************************************************************************/ -/* */ -/* Routines to access "header" variables. */ -/* */ -/*-- */ -/* History: */ -/* rjs Dark_ages Original version */ -/* rjs 23aug89 Fixed char variable overrun problem, in hdprobe. */ -/* rjs 12feb90 Added some comments, to appease PJT. */ -/* rjs 21feb90 Corrected a comment. */ -/* rjs 7mar90 Added hisopen with status='write' */ -/* rjs 27apr90 Fixed bug in hdprobe, which got the lengths of items */ -/* less than ITEM_HDR_SIZE long wrong. */ -/* pjt 19mar91 output double prec variables in -20.10g */ -/* rjs 26aug92 Corrected hdprsnt declaration, and the value that */ -/* it returns. */ -/* rjs 23feb93 Rename a defined parameter only. */ -/* rjs 10aug93 Use hexists in hdprsnt. */ -/* rjs 6nov94 Change "item handle" to an integer. */ -/* rjs 15may96 Fiddles with roundup macro. */ -/* pjt 27mar99 make history a static, so nobody can see it :-) */ -/* rjs 29apr99 Get hdprobe to check for string buffer overflow. */ -/* dpr 11may01 Descriptive error for hisopen_c */ -/* pjt 22jun02 MIR4 prototypes and using int8 for long integers */ -/* pjt/rjs 1jan05 replaced shortcut rdhdd code with their own readers */ -/* this fixes a serious bug in rdhdl for large values */ -/* Also adding in some bugv_c() called to replace bug_c */ -/* pjt 12jan05 Fixed up type conversion for int8's in rhhdl */ -/* pjt 6feb05 rdhdd_c() : no more type check (see comment in code) */ -/* pjt 17feb05 fixed bug in reading int8's from old MIR3 files */ -/* pjt 6sep06 read integers via rdhdi */ -/************************************************************************/ - -#if defined(HAVE_CONFIG_H) && HAVE_CONFIG_H -#include "config.h" -#endif - -#include <stdlib.h> -#include <string.h> -#include <ctype.h> -#include <stdio.h> -#include "miriad.h" -#include "io.h" - -#define check(iostat) if(iostat)bugno_c('f',iostat) -#define MAXSIZE 1024 -#define MAXLINE 80 - - -static int history[MAXOPEN]; - -#define Sprintf (void)sprintf -#define Strcpy (void)strcpy - -/************************************************************************/ -void hisopen_c(int tno,Const char *status) -/** hisopen -- Open the history file. */ -/*& pjt */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine hisopen(tno,status) - integer tno - character status - - This opens the history file, and readies it to be read or written. - - Inputs: - tno The handle of the open data set. - status Either "read", "write" or "append". */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int iostat; - haccess_c(tno,&history[tno],"history",status,&iostat); - if(iostat) {bug_c('e',"Problem with history item");}; - check(iostat); -} -/************************************************************************/ -void hiswrite_c(int tno,Const char *text) -/** hiswrite -- Write a line of text to the history file. */ -/*& pjt */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine hiswrite(tno,line) - integer tno - character line*(*) - - This writes a text string to the history file associated with an open - data set. - - Inputs: - tno The handle of the open data set. - line The string of text to be written to the history file. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int iostat; - hwritea_c(history[tno],text,strlen(text)+1,&iostat); check(iostat); -} -/************************************************************************/ -void hisread_c(int tno,char *text,size_t length,int *eof) -/** hisread -- Read a line of text from the history file. */ -/*& pjt */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine hisread(tno,line,eof) - integer tno - character line*(*) - logical eof - - This reads a line of text from the history file. - - Input: - tno The handle of the input data set. - Output: - line The string to receive the read string. - eof This logical variable turns true when the end of the - history file is reached. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int iostat; - hreada_c(history[tno],text,length,&iostat); - if(iostat == 0) *eof = FORT_FALSE; - else if(iostat == -1) *eof = FORT_TRUE; - else bugno_c('f',iostat); -} -/************************************************************************/ -void hisclose_c(int tno) -/** hisclose -- This closes the history file. */ -/*& pjt */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine hisclose(tno - integer tno - - This closes the history file associated with a particular data set. - Input: - tno The handle of the data set. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int iostat; - hdaccess_c(history[tno],&iostat); check(iostat); -} -/************************************************************************/ -void wrhdr_c(int thandle,Const char *keyword,double value) -/** wrhdr -- Write a real valued header variable. */ -/*& pjt */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine wrhdr(tno,keyword,value) - integer tno - character keyword*(*) - real value - - This writes a real-valued header keyword. - Input: - tno Handle of the data set. - keyword Name of the keyword to write. - value The value of the keyword. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int item; - float temp; - int iostat,offset; - - temp = value; - haccess_c(thandle,&item,keyword,"write",&iostat); check(iostat); - hwriteb_c(item,real_item,0,ITEM_HDR_SIZE,&iostat); check(iostat); - offset = mroundup(ITEM_HDR_SIZE,H_REAL_SIZE); - hwriter_c(item,&temp,offset,H_REAL_SIZE,&iostat); check(iostat); - hdaccess_c(item,&iostat); check(iostat); -} -/************************************************************************/ -void wrhdd_c(int thandle,Const char *keyword,double value) -/** wrhdd -- Write a double precision valued header variable. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine wrhdd(tno,keyword,value) - integer tno - character keyword*(*) - double precision value - - Write the value of a header variable which has a double precision value. - - Input: - tno The handle of the data set. - keyword Name to the keyword. - value The double precision value. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int item; - int iostat,offset; - - haccess_c(thandle,&item,keyword,"write",&iostat); check(iostat); - hwriteb_c(item,dble_item,0,ITEM_HDR_SIZE,&iostat); check(iostat); - offset = mroundup(ITEM_HDR_SIZE,H_DBLE_SIZE); - hwrited_c(item,&value,offset,H_DBLE_SIZE,&iostat); check(iostat); - hdaccess_c(item,&iostat); check(iostat); -} -/************************************************************************/ -void wrhdi_c(int thandle,Const char *keyword,int value) -/** wrhdi -- Write an integer valued header variable. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine wrhdi(tno,keyword,value) - integer tno - character keyword*(*) - integer value - - Write an integer valued header variable. - - Input: - tno The handle of the data set. - keyword The name of the header variable. - value The integer value of the header variable. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int item; - int iostat,offset; - - haccess_c(thandle,&item,keyword,"write",&iostat); check(iostat); - hwriteb_c(item,int_item,0,ITEM_HDR_SIZE,&iostat); check(iostat); - offset = mroundup(ITEM_HDR_SIZE,H_INT_SIZE); - hwritei_c(item,&value,offset,H_INT_SIZE,&iostat); check(iostat); - hdaccess_c(item,&iostat); check(iostat); -} -/************************************************************************/ -void wrhdl_c(int thandle,Const char *keyword,int8 value) -/** wrhdl -- Write an integer*8 valued header variable. */ -/*& pjt */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine wrhdl(tno,keyword,value) - integer tno - character keyword*(*) - integer*8 value - - Write an integer*8 valued header variable. This is only supported - on compilers that know how to handle integer*8 (e.g. gnu, intel). - Without this support, some files in miriad will be limited to - 8 GB. - - Input: - tno The handle of the data set. - keyword The name of the header variable. - value The integer*8 value of the header variable. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int item; - int iostat,offset; - - /* Sault proposes to write an INT if below 2^31, else INT8 */ - - haccess_c(thandle,&item,keyword,"write",&iostat); check(iostat); - hwriteb_c(item,int8_item,0,ITEM_HDR_SIZE,&iostat); check(iostat); - offset = mroundup(ITEM_HDR_SIZE,H_INT8_SIZE); - hwritel_c(item,&value,offset,H_INT8_SIZE,&iostat); check(iostat); - hdaccess_c(item,&iostat); check(iostat); -} -/************************************************************************/ -void wrhdc_c(int thandle,Const char *keyword,Const float *value) -/** wrhdc -- Write a complex-valued header variable. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine wrhdc(tno,keyword,value) - integer tno - character keyword*(*) - complex value - - Write a complex valued header variable. - Input: - tno The file handle fo the data set. - keyword The name of the header variable. - value The complex value of the header variable. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int item; - int iostat,offset; - - haccess_c(thandle,&item,keyword,"write",&iostat); check(iostat); - hwriteb_c(item,cmplx_item,0,ITEM_HDR_SIZE,&iostat); check(iostat); - offset = mroundup(ITEM_HDR_SIZE,H_CMPLX_SIZE); - hwritec_c(item,value,offset,H_CMPLX_SIZE,&iostat); check(iostat); - hdaccess_c(item,&iostat); check(iostat); -} -/************************************************************************/ -void wrhda_c(int thandle,Const char *keyword,Const char *value) -/** wrhda -- Write a string-valued header variable. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine wrhda(tno,keyword,value) - integer tno - character keyword*(*) - character value*(*) - - Write a string valued header variable. - - Input: - tno The file handle of the data set. - keyword The name of the header variable. - value The value of the header variable. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int item; - int iostat; - - haccess_c(thandle,&item,keyword,"write",&iostat); check(iostat); - hwriteb_c(item,char_item,0,ITEM_HDR_SIZE,&iostat); check(iostat); - hwriteb_c(item,(char *)value,ITEM_HDR_SIZE, - strlen(value),&iostat); check(iostat); - hdaccess_c(item,&iostat); check(iostat); -} -/************************************************************************/ -void rdhdr_c(int thandle,Const char *keyword,float *value,double defval) -/** rdhdr -- Read a real-valued header variable. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine rdhdr(tno,keyword,value,default) - integer tno - character keyword*(*) - real value,default - - Read a real valued header variable. - - Input: - tno The file handle of the data set. - keyword The name of the header variable. - default The default value to return, if the header variable - is not found. - Output: - value The value of the header variable. This will be the default - value, if the variable is missing from the header. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - double dvalue,ddefval; - ddefval = defval; - rdhdd_c(thandle,keyword,&dvalue,ddefval); - *value = dvalue; -} -/************************************************************************/ -void rdhdi_c(int thandle,Const char *keyword,int *value,int defval) -/** rdhdi -- Read an integer-valued header variable. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine rdhdi(tno,keyword,value,default) - integer tno - character keyword*(*) - integer value,default - - Read an integer valued header variable. - - Input: - tno The file handle of the data set. - keyword The name of the header variable. - default The default value to return, if the header variable - is not found. - Output: - value The value of the header variable. This will be the default - value, if the variable is missing from the header. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int8 lvalue,ldefval; - ldefval = defval; - rdhdl_c(thandle,keyword,&lvalue,ldefval); - - if(lvalue > 0x7FFFFFFF) - bugv_c('f',"Item %s too large for rdhdi: %ld",keyword,lvalue); - *value = lvalue; -} -/************************************************************************/ -void rdhdl_c(int thandle,Const char *keyword,int8 *value,int8 defval) -/** rdhdl -- Read an integer*8-valued header variable. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine rdhdl(tno,keyword,value,default) - integer tno - character keyword*(*) - integer*8 value,default - - Read an integer*8 valued header variable. Only supported on some - compilers. See comments in wrhdl - - Input: - tno The file handle of the data set. - keyword The name of the header variable. - default The default value to return, if the header variable - is not found. - Output: - value The value of the header variable. This will be the default - value, if the variable is missing from the header. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int item; - char s[ITEM_HDR_SIZE]; - int iostat,length,offset,itemp; - -/* Firstly assume the variable is missing. Try to get it. If successful - read it. */ - - *value = defval; - haccess_c(thandle,&item,keyword,"read",&iostat); if(iostat)return; - length = hsize_c(item); - if(length >= 0){ - -/* Determine the type of the value, and convert it to double precision. */ - - hreadb_c(item,s,0,ITEM_HDR_SIZE,&iostat); check(iostat); - iostat = 0; - if( !memcmp(s,int8_item, ITEM_HDR_SIZE)){ - offset = mroundup(ITEM_HDR_SIZE, H_INT8_SIZE); - if(offset + H_INT8_SIZE == length) - hreadl_c(item,value,offset,H_INT8_SIZE,&iostat); - } else if ( !memcmp(s,int_item, ITEM_HDR_SIZE)){ - /* this is to cover old style MIR3 files that were using int4's */ - offset = mroundup(ITEM_HDR_SIZE, H_INT_SIZE); - if(offset + H_INT_SIZE == length) { - hreadi_c(item,&itemp,offset,H_INT_SIZE,&iostat); - *value = itemp; - } - } else - bugv_c('f',"rdhdl_c: item %s not an int8 or small enough int4",keyword); - - check(iostat); - } - hdaccess_c(item,&iostat); check(iostat); - -} -/************************************************************************/ -void rdhdd_c(int thandle,Const char *keyword,double *value,double defval) -/** rdhdd -- Read a double precision-valued header variable. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine rdhdd(tno,keyword,value,default) - integer tno - character keyword*(*) - double precision value,default - - Read a double precision valued header variable. - - Input: - tno The file handle of the data set. - keyword The name of the header variable. - default The default value to return, if the header variable - is not found. - Output: - value The value of the header variable. This will be the default - value, if the variable is missing from the header. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int item; - char s[ITEM_HDR_SIZE]; - int iostat,length,itemp,offset; - float rtemp; - -/* Firstly assume the variable is missing. Try to get it. If successful - read it. */ - - *value = defval; - haccess_c(thandle,&item,keyword,"read",&iostat); if(iostat)return; - length = hsize_c(item); - if(length >= 0){ - -/* Determine the type of the value, and convert it to double precision. */ - - hreadb_c(item,s,0,ITEM_HDR_SIZE,&iostat); check(iostat); - iostat = 0; - if( !memcmp(s,int_item, ITEM_HDR_SIZE)){ - offset = mroundup(ITEM_HDR_SIZE,H_INT_SIZE); - if(offset + H_INT_SIZE == length){ - hreadi_c(item,&itemp,offset,H_INT_SIZE,&iostat); - *value = itemp; - } - } else if(!memcmp(s,real_item,ITEM_HDR_SIZE)){ - offset = mroundup(ITEM_HDR_SIZE,H_REAL_SIZE); - if(offset + H_REAL_SIZE == length){ - hreadr_c(item,&rtemp,offset,H_REAL_SIZE,&iostat); - *value = rtemp; - } - } else if(!memcmp(s,dble_item,ITEM_HDR_SIZE)){ - offset = mroundup(ITEM_HDR_SIZE,H_DBLE_SIZE); - if(offset + H_DBLE_SIZE == length){ - hreadd_c(item,value, offset,H_DBLE_SIZE,&iostat); - } - } -#if 0 - /* can't do this: some routines, e.g. imhead, actually depend - * on it falling through. Sick, but true - */ - else - bugv_c('f',"rdhdd_c: keyword %s not covered here",keyword); -#endif - - check(iostat); - } - hdaccess_c(item,&iostat); check(iostat); -} -/************************************************************************/ -void rdhdc_c(int thandle,Const char *keyword,float *value,Const float *defval) -/** rdhdc -- Read a complex-valued header variable. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine rdhdc(tno,keyword,value,default) - integer tno - character keyword*(*) - complex value,default - - Read a complex valued header variable. - - Input: - tno The file handle of the data set. - keyword The name of the header variable. - default The default value to return, if the header variable - is not found. - Output: - value The value of the header variable. This will be the default - value, if the variable is missing from the header. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int item; - char s[ITEM_HDR_SIZE]; - int iostat,length,offset; - -/* Firstly assume the variable is missing. Try to get it. If successful - read it. */ - - *value = *defval; - *(value+1) = *(defval+1); - haccess_c(thandle,&item,keyword,"read",&iostat); if(iostat)return; - offset = mroundup(ITEM_HDR_SIZE,H_CMPLX_SIZE); - length = hsize_c(item) - offset; - if(length == H_CMPLX_SIZE){ - hreadb_c(item,s,0,ITEM_HDR_SIZE,&iostat); check(iostat); - iostat = 0; - if(!memcmp(s,cmplx_item, ITEM_HDR_SIZE)){ - hreadc_c(item,value,offset,H_CMPLX_SIZE,&iostat); - } - check(iostat); - } - hdaccess_c(item,&iostat); check(iostat); -} -/************************************************************************/ -void rdhda_c(int thandle,Const char *keyword,char *value,Const char *defval,int len) -/** rdhda -- Read a string-valued header variable. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine rdhda(tno,keyword,value,default) - integer tno - character keyword*(*) - character value*(*),default*(*) - - Read a string valued header variable. - - Input: - tno The file handle of the data set. - keyword The name of the header variable. - default The default value to return, if the header variable - is not found. - Output: - value The value of the header variable. This will be the default - value, if the variable is missing from the header. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int item; - char s[ITEM_HDR_SIZE]; - int iostat,dodef,length=0; - -/* Firstly assume the variable is missing. Try to get it. If successful - read it. */ - - dodef = TRUE; - haccess_c(thandle,&item,keyword,"read",&iostat); - if(! iostat) { - length = min( hsize_c(item) - ITEM_HDR_SIZE, len - 1); - if(length > 0) { - hreadb_c(item,s,0,ITEM_HDR_SIZE,&iostat); check(iostat); - if(!memcmp(s,char_item,ITEM_HDR_SIZE)){ - hreadb_c(item,value,ITEM_HDR_SIZE,length,&iostat); check(iostat); - dodef = FALSE; - } - } - hdaccess_c(item,&iostat); check(iostat); - } - if( dodef ) { - length = min((int)strlen(defval),len-1); - memcpy(value,defval,length); - } - *(value+length) = 0; -} -/************************************************************************/ -void hdcopy_c(int tin,int tout,Const char *keyword) -/** hdcopy -- Copy a headfer variable from one data set to another. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine hdcopy(tin,tout,keyword) - integer tin,tout - character keyword*(*) - - Copy a header item from one data set to another. - - Input: - tin File handle of the input data set. - tout File handle of the output data set. - keyword Name of the header variable to be copied. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - char buf[MAXSIZE]; - int item_in,item_out; - int length,offset,iostat,size; - - haccess_c(tin,&item_in,keyword,"read",&iostat); if(iostat)return; - haccess_c(tout,&item_out,keyword,"write",&iostat); check(iostat); - - size = hsize_c(item_in); - offset = 0; - while(offset < size){ - length = min(size - offset, (int)sizeof(buf)); - hreadb_c(item_in,buf,offset,length,&iostat); check(iostat); - hwriteb_c(item_out,buf,offset,length,&iostat); check(iostat); - offset += length; - } - hdaccess_c(item_in,&iostat); check(iostat); - hdaccess_c(item_out,&iostat); check(iostat); -} -/************************************************************************/ -int hdprsnt_c(int tno,Const char *keyword) -/** hdprsnt -- Determine if a header variable is present. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - logical function hdprsnt(tno,keyword) - integer tno - character keyword*(*) - - Check if a particular header variable is present in a data set. - - Input: - tno File handle of the data set to check. - keyword Name of the header variable to check for. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - if(hexists_c(tno,keyword))return(FORT_TRUE); - else return(FORT_FALSE); -} -/************************************************************************/ -void hdprobe_c(int tno,Const char *keyword,char *descr,size_t length,char *type,int *n) -/** hdprobe -- Determine characteristics of a header variable. */ -/*& mjs */ -/*: header-i/o */ -/*+ FORTRAN call sequence: - - subroutine hdprobe(tno,keyword,descr,type,n) - integer tno - character keyword*(*),descr*(*),type*(*) - integer n - - Determine characteristics of a particular header variable. - Inputs: - tno Handle of the data set. - keyword Name of the header variable to probe. - - Outputs: - descr A formatted version of the item. For single numerics or - short strings, this is the ascii encoding of the value. For - large items, this is some message describing the item. - type One of: - 'nonexistent' - 'integer*2' - 'integer*8' - 'integer' - 'real' - 'double' - 'complex' - 'character' - 'text' - 'binary' - n Number of elements in the item. Zero implies an error. One - implies that "descr" is the ascii encoding of the value. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int item; - char s[ITEM_HDR_SIZE],buf[MAXSIZE]; - float rtemp,ctemp[2]; - int iostat,unknown,size,i,itemp,offset,bufit; - double dtemp; - int2 jtemp; - int8 ltemp; - - haccess_c(tno,&item,keyword,"read",&iostat); - *n = 0; - bufit = 0; - Strcpy(type,"nonexistent"); if(iostat)return; - size = hsize_c(item); - unknown = FALSE; - if(size <= ITEM_HDR_SIZE){ - unknown = TRUE; - size -= ITEM_HDR_SIZE; - } else { - hreadb_c(item,s,0,ITEM_HDR_SIZE,&iostat); check(iostat); - if(!memcmp(s,real_item,ITEM_HDR_SIZE)){ - offset = mroundup(ITEM_HDR_SIZE,H_REAL_SIZE); - size -= offset; - Strcpy(type,"real"); - *n = size / H_REAL_SIZE; - if(size % H_REAL_SIZE) unknown = TRUE; - else if(size == H_REAL_SIZE){ - hreadr_c(item,&rtemp,offset,H_REAL_SIZE,&iostat); check(iostat); - Sprintf(buf,"%-14.7g",rtemp); - bufit = 1; - } - } else if(!memcmp(s,int_item,ITEM_HDR_SIZE)){ - offset = mroundup(ITEM_HDR_SIZE,H_INT_SIZE); - size -= offset; - Strcpy(type,"integer"); - *n = size / H_INT_SIZE; - if(size % H_INT_SIZE) unknown = TRUE; - else if(size == H_INT_SIZE){ - hreadi_c(item,&itemp,offset,H_INT_SIZE,&iostat); check(iostat); - Sprintf(buf,"%d",itemp); - bufit = 1; - } - } else if(!memcmp(s,int2_item,ITEM_HDR_SIZE)){ - offset = mroundup(ITEM_HDR_SIZE,H_INT2_SIZE); - size -= offset; - Strcpy(type,"integer*2"); - *n = size / H_INT2_SIZE; - if(size % H_INT2_SIZE) unknown = TRUE; - else if(size == H_INT2_SIZE){ - hreadj_c(item,&jtemp,offset,H_INT2_SIZE,&iostat); check(iostat); - Sprintf(buf,"%d",jtemp); - bufit = 1; - } - } else if(!memcmp(s,int8_item,ITEM_HDR_SIZE)){ - offset = mroundup(ITEM_HDR_SIZE,H_INT8_SIZE); - size -= offset; - Strcpy(type,"integer*8"); - *n = size / H_INT8_SIZE; - if(size % H_INT8_SIZE) unknown = TRUE; - else if(size == H_INT8_SIZE){ - hreadl_c(item,<emp,offset,H_INT8_SIZE,&iostat); check(iostat); - Sprintf(buf,"%lld",ltemp); - bufit = 1; - } - } else if(!memcmp(s,dble_item,ITEM_HDR_SIZE)){ - offset = mroundup(ITEM_HDR_SIZE,H_DBLE_SIZE); - size -= offset; - Strcpy(type,"double"); - *n = size / H_DBLE_SIZE; - if(size % H_DBLE_SIZE) unknown = TRUE; - else if(size == H_DBLE_SIZE){ - hreadd_c(item,&dtemp,offset,H_DBLE_SIZE,&iostat); check(iostat); - Sprintf(buf,"%-20.10g",dtemp); - bufit = 1; - } - } else if(!memcmp(s,cmplx_item,ITEM_HDR_SIZE)){ - offset = mroundup(ITEM_HDR_SIZE,H_CMPLX_SIZE); - size -= offset; - Strcpy(type,"complex"); - *n = size / H_CMPLX_SIZE; - if(size % H_CMPLX_SIZE) unknown = TRUE; - else if(size == H_CMPLX_SIZE){ - hreadr_c(item,ctemp,offset,H_CMPLX_SIZE,&iostat); check(iostat); - Sprintf(buf,"(%-14.7g,%-14.7g)",ctemp[0],ctemp[1]); - bufit = 1; - } - } else if(!memcmp(s,char_item,ITEM_HDR_SIZE)){ - offset = ITEM_HDR_SIZE; - size -= offset; - size = min(size,MAXSIZE-1); - *n = 1; - Strcpy(type,"character"); - hreadb_c(item,buf,ITEM_HDR_SIZE,size,&iostat); check(iostat); - *(buf+size) = 0; - bufit = 1; - } else if(!memcmp(s,binary_item,ITEM_HDR_SIZE)){ - *n = size; - Strcpy(type,"binary"); - } else{ - Strcpy(type,"text"); - *n = size + ITEM_HDR_SIZE; - for(i=0; i < ITEM_HDR_SIZE; i++) - if(!isspace(*(s+i)) && !isprint(*(s+i)))unknown = TRUE; - } - } - hdaccess_c(item,&iostat); check(iostat); - if(unknown){ - Strcpy(type,"unknown"); - *n = size + ITEM_HDR_SIZE; - } else if(bufit){ - if(strlen(buf) > length - 1) - bugv_c('f',"Descr buffer overflow in hdprobe for %s",keyword); - strcpy(descr,buf); - } -} Index: casacore-3.5.0/mirlib/hio.c =================================================================== --- casacore-3.5.0.orig/mirlib/hio.c +++ /dev/null @@ -1,1526 +0,0 @@ -/* - The routines to manipulate the file hierarchy. - - 6-dec-89 pjt extended bug() messages - 30-apr-90 rjs Support for zero-length items. Added hdelete. - 15-jul-91 rjs Check for valid item names in hopen and hdelete. - Some mods to some error messages. - 18-jul-91 rjs Fixed the name checking to accept the "." file. - 2-aug-91 rjs Fixed the name checking to accept '-'. - 16-oct-91 rjs Truncated an item when it is opened for rewriting. - 12-oct-92 rjs Changed "roundup" macro definition, for pjt. - 3-mar-93 rjs Add hflush. - 10-aug-93 rjs Add hexists. - 26-aug-93 rjs Add habort,hrm. - 30-aug-93 rjs Add hseek, htell. - 7-sep-93 rjs Bug fix in habort. - 23-dec-93 rjs hexists did not handle tno==0 correctly. - 5-jan-93 rjs Added hmode to check access mode of dataset. - 4-nov-94 rjs Changes to the way trees and items are stored. - 15-nov-94 rjs Fixed bug affecting small items being rewritten - before the dataset is closed. - 27-dec-94 pjt Fixed (?) bug in hexist for regular files - and documented this feature - 13-mar-95 rjs Increase max number of open items. - 30-jun-95 rjs Declaration to appease gcc. - 15-may-96 rjs More fiddles with roundup macro. - 18-mar-97 rjs Remove alignment restriction on hio_c. - 21-mar-97 rjs Make some previously dynamic allocations static. - 30-sep-97 rjs Start ntree off at 1 (rather than 0). - 28-nov-97 rjs Change to cope with text files which do not end with - a newline char. - 09-may-00 rjs Get rid of spurious error message in hrm_c. Why didn't - I see this ages ago? - 10-jun-02 pjt MIR4 changes to handle 2GB+ files and new int8 types - 15-jan-03 pjt fix a few prototypes for Const's - 30-jan-03 pjt allow itemnames to contain _ (e.g. for cd1_1) - 23-feb-03 pjt merged MIR4 - 22-jul-04 jwr changed type of "size" in hexists_c() from int to size_t - 05-nov-04 jwr changed file sizes from size_t to off_t - 01-jan-05 pjt a few bug_c() -> bugv_c() - 03-jan-05 pjt/rjs hreada/hwritea off_t -> size_t for length - 12-jul-11 pjt applied ATNF fix of some static function use off_t/size_t - 19-jun-12 pjt fixed hashing bug colliding with handle=0 -*/ - -#if defined(HAVE_CONFIG_H) && HAVE_CONFIG_H -#include "config.h" -#endif - -#include <stdlib.h> -#include <string.h> - -#include "hio.h" -#include "miriad.h" - -#define private static -#if !defined(NULL) -# define NULL 0 -#endif - -#define MAXNAME 9 -#define CACHESIZE 64 /* Max size of items to cache. */ -#define CACHE_ENT 16 /* Alignment of cache items. */ - -#define IO_VALID 0 /* Set if the i/o buffer is valid. */ -#define IO_ACTIVE 1 -#define IO_MODIFIED 2 -#define ITEM_READ 0x1 -#define ITEM_WRITE 0x2 -#define ITEM_SCRATCH 0x4 -#define ITEM_APPEND 0x8 -#define ACCESS_MODE (ITEM_READ|ITEM_WRITE|ITEM_SCRATCH|ITEM_APPEND) -#define ITEM_CACHE 0x10 -#define ITEM_NOCACHE 0x20 - -#define TREE_CACHEMOD 0x1 -#define TREE_NEW 0x2 - -#define RDWR_UNKNOWN 0 -#define RDWR_RDONLY 1 -#define RDWR_RDWR 2 - -typedef struct { /* buffer for I/O operations */ - off_t offset; - size_t length; - int state; - char *buf; -} IOB; - -typedef struct item { - char *name; - int handle,flags,fd,last; - off_t size; - size_t bsize; /* bsize can technicall be an int, since it's an internal buffer size */ - off_t offset; - struct tree *tree; - IOB io[2]; - struct item *fwd; -} ITEM; - -typedef struct tree { - char *name; - int handle,flags,rdwr,wriostat; - ITEM *itemlist; -} TREE; - -static TREE foreign = {"",0,0,0,0,NULL}; -#define MAXITEM 1024 - -private int nitem,ntree; -private TREE *tree_addr[MAXOPEN]; -private ITEM *item_addr[MAXITEM]; - -#define hget_tree(tno) (tree_addr[tno]) -#define hget_item(tno) (item_addr[tno]) - -private int header_ok,expansion[MAXTYPES],align_size[MAXTYPES]; -private char align_buf[BUFSIZE]; -private int first=TRUE; - -/* Macro to wait for I/O to complete. If its a synchronous i/o system, - never bother calling the routine to wait for i/o completion. */ - -#if BUFDBUFF -#define WAIT(item,iostat) \ - if((item)->io[0].state == IO_ACTIVE){ \ - dwait_c((item)->fd,iostat); \ - (item)->io[0].state = IO_VALID; \ - } else if((item)->io[1].state == IO_ACTIVE){ \ - dwait_c((item)->fd,iostat); \ - (item)->io[1].state = IO_VALID; \ - } -#else -#define WAIT(a,b) -#define dwait_c(a,b) -#endif - -/* Declare our private routines. */ - -static void hinit_c(void); -static int hfind_nl(char *buf, size_t len); -static void hcheckbuf_c(ITEM *item, off_t next, int *iostat); -static void hwrite_fill_c(ITEM *item, IOB *iob, off_t next, int *iostat); -static void hcache_create_c(TREE *t, int *iostat); -static void hcache_read_c(TREE *t, int *iostat); -static int hname_check(char *name); -static void hdir_c(ITEM *item); -static void hrelease_item_c(ITEM *item); -static ITEM *hcreate_item_c(TREE *tree, char *name); -static TREE *hcreate_tree_c(char *name); - -#define check(iostat) if(iostat) bugno_c('f',iostat) -#define Malloc(a) malloc((size_t)(a)) -#define Realloc(a,b) realloc((a),(size_t)(b)) -#define Strcpy (void)strcpy -#define Strcat (void)strcat -#define Memcpy (void)memcpy - -/************************************************************************/ -void hopen_c(int *tno,Const char *name,Const char *status,int *iostat) -/**hopen -- Open a data set. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - subroutine hopen(tno,name,status,iostat) - integer tno,iostat - character name*(*),status*(*) - - This opens a Miriad data-set, and readies it to be read or written. - - Input: - name The name of the data set. - status Either 'old' or 'new'. - Output: - tno The file handle of the opened data set. - iostat I/O status indicator. 0 indicates success. Other values - are standard system error numbers. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - char path[MAXPATH]; - TREE *t; - -/* Initialise if its the first time through. */ - - if(first)hinit_c(); - -/* Find a spare slot, and set the name etc. */ - - dtrans_c((char *)name,path,iostat); - if(*iostat)return; - t = hcreate_tree_c(path); - -/* Either open an old cache, or create a new cache. */ - - if(!strcmp(status,"old")){ - hcache_read_c(t,iostat); - t->rdwr = RDWR_UNKNOWN; - } else if(!strcmp(status,"new")){ - dmkdir_c(path,iostat); - if(!*iostat)hcache_create_c(t,iostat); - t->flags |= TREE_NEW; - t->rdwr = RDWR_RDWR; - } else *iostat = -1; - -/* Tidy up before we return. Make sure things are tidy if an error - occurred during the operation. */ - - *tno = t->handle; - if(*iostat) hclose_c(*tno); - -} -/************************************************************************/ -private void hinit_c() -/* - Initialise everthing the first time through. -------------------------------------------------------------------------*/ -{ - int i; - - nitem = 0; - ntree = 1; - for(i=0; i < MAXITEM; i++)item_addr[i] = NULL; - for(i=0; i < MAXOPEN; i++)tree_addr[i] = NULL; - -/* Tree-0 is a special tree used for "foreign" files. */ - - tree_addr[0] = &foreign; - - expansion[H_BYTE] = 1; - expansion[H_INT] = sizeof(int)/H_INT_SIZE; - expansion[H_INT2] = sizeof(int2)/H_INT2_SIZE; - expansion[H_INT8] = sizeof(int8)/H_INT8_SIZE; - expansion[H_REAL] = sizeof(float)/H_REAL_SIZE; - expansion[H_DBLE] = sizeof(double)/H_DBLE_SIZE; - expansion[H_CMPLX] = 2*sizeof(float)/H_CMPLX_SIZE; - expansion[H_TXT] = 1; - - align_size[H_BYTE] = 1; - align_size[H_INT] = H_INT_SIZE; - align_size[H_INT2] = H_INT2_SIZE; - align_size[H_INT8] = H_INT8_SIZE; - align_size[H_REAL] = H_REAL_SIZE; - align_size[H_DBLE] = H_DBLE_SIZE; - align_size[H_CMPLX] =H_REAL_SIZE; - align_size[H_TXT] = 1; - first = FALSE; - header_ok = FALSE; -} -/************************************************************************/ -void hflush_c(int tno,int *iostat) -/**hflush -- Close a Miriad data set. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - subroutine hflush(tno,iostat) - integer tno,iostat - - Write to disk any changed items. - - Input: - tno The handle of the Miriad data set. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - TREE *t; - ITEM *item; - char s[CACHE_ENT]; - int i, ihandle; - off_t offset; - - t = hget_tree(tno); - *iostat = 0; - -/* Determine whether the cache needs to be rewritten, and write out - any modified buffers. */ - - for(item = t->itemlist; item != NULL ; item = item->fwd){ - if(!item->fd && !(item->flags & ITEM_NOCACHE) ){ - if(item->io[0].state == IO_MODIFIED) t->flags |= TREE_CACHEMOD; - } else if(item->fd && !(item->flags & ITEM_SCRATCH) ){ - for(i=0; i<2; i++){ - if(item->io[i].state == IO_MODIFIED){ - WAIT(item,iostat); - if(*iostat)return; - dwrite_c( item->fd, item->io[i].buf, item->io[i].offset, - item->io[i].length, iostat); - if(*iostat)return; - item->io[i].state = IO_ACTIVE; - } - } - } - } - -/* If the cache has been modified, rewrite the cache. */ - - if(t->flags & TREE_CACHEMOD){ - header_ok = TRUE; - haccess_c(tno,&ihandle,"header","write",iostat); - header_ok = FALSE; if(*iostat)return; - for(i=0; i < CACHE_ENT; i++)s[i] = 0; - - offset = 0; - for(item = t->itemlist; item != NULL; item = item->fwd){ - if(!item->fd && !(item->flags & ITEM_NOCACHE)){ - Strcpy(s,item->name); - s[CACHE_ENT-1] = item->size; - hwriteb_c(ihandle,s,offset,CACHE_ENT,iostat); if(*iostat)return; - offset += CACHE_ENT; - if(item->size > 0){ - hwriteb_c(ihandle,item->io[0].buf,offset,item->size,iostat); - if(*iostat)return; - } - item->io[0].state = IO_VALID; - item->flags |= ITEM_CACHE; - offset += mroundup(item->size,CACHE_ENT); - } - } - hdaccess_c(ihandle,iostat); if(*iostat)return; - t->flags &= ~TREE_CACHEMOD; - } - *iostat = 0; -} -/************************************************************************/ -void habort_c() -/**habort -- Abort handling of all open data-sets. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - subroutine habort() - - This closes all open Miriad data-sets, and deletes any new ones. No - buffers are flushed. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int i,iostat; - TREE *t; - ITEM *it,*itfwd; - char name[MAXPATH]; - -/* Don't do anything if the hio routines have never been called. */ - - if(first)return; - -/* Flush everything belonging to tree 0. */ - - hflush_c(0,&iostat); - -/* Check each possible tree. */ - - for( i=0; i < MAXOPEN; i++){ - if( (t = hget_tree(i) ) != NULL){ - it = t->itemlist; - while(it != NULL){ - itfwd = it->fwd; - -/* Wait for any i/o to complete, and prevent further flushing of the buffers - by pretending that nothing has been modified. */ - - WAIT(it,&iostat); - it->io[0].state = IO_VALID; - it->io[1].state = IO_VALID; - -/* If its an item opened in WRITE mode, remember its name. */ - - if(it->flags & ITEM_WRITE)Strcpy(name,it->name); - else name[0] = 0; - -/* If the item is open, close it. */ -/* If it was in write mode, and the name was known, delete it. */ - - if(it->flags & ACCESS_MODE)hdaccess_c(it->handle,&iostat); - if(*name)hdelete_c(t->handle,name,&iostat); - it = itfwd; - } - -/* Pretend the cache has not changed and finish up. Completely delete - trees that were opened as NEW. Otherwise finish up. */ - - t->flags &= ~TREE_CACHEMOD; - if(t->flags & TREE_NEW)hrm_c(t->handle); - else if(i != 0)hclose_c(t->handle); - } - } -} -/************************************************************************/ -void hrm_c(int tno) -/**hrm -- Remove a data-set. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - subroutine hrm(tno) - - integer tno - - This completely removes a Miriad data-set. - - Input: - tno The file handle of the open data-set. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - char name[MAXPATH]; - int iostat,ihandle; - TREE *t; - - haccess_c(tno,&ihandle,".","read",&iostat); - if(iostat == 0){ - hreada_c(ihandle,name,MAXPATH,&iostat); - while(iostat == 0){ - hdelete_c(tno,name,&iostat); - hreada_c(ihandle,name,MAXPATH,&iostat); - } - hdaccess_c(ihandle,&iostat); - } - -/* Delete the "header" item. */ - - header_ok = TRUE; - hdelete_c(tno,"header",&iostat); - header_ok = FALSE; - -/* Delete the directory itself. */ - - t = hget_tree(tno); - t->flags &= ~TREE_CACHEMOD; - drmdir_c(t->name,&iostat); - hclose_c(tno); -} -/************************************************************************/ -void hclose_c(int tno) -/**hclose -- Close a Miriad data set. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - subroutine hclose(tno) - integer tno - - This closes a Miriad data set. The data set cannot be accessed after the - close. - - Input: - tno The handle of the Miriad data set. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - TREE *t; - ITEM *item,*it1,*it2; - int iostat; - -/* Close any open items. */ - - t = hget_tree(tno); - for(item=t->itemlist; item != NULL; item = item->fwd){ - if(item->flags & ACCESS_MODE){ - bugv_c('w',"Closing item -- %s",item->name); - hdaccess_c(item->handle,&iostat); check(iostat); - } - } - -/* Flush out the header, if needed. */ - - hflush_c(tno,&iostat); check(iostat); - -/* Release all allocated stuff. */ - - it1 = t->itemlist; - while(it1 != NULL){ - it2 = it1->fwd; - hrelease_item_c(it1); - it1 = it2; - } - tree_addr[tno] = NULL; - free(t->name); - free((char *)t); - ntree--; -} -/************************************************************************/ -void hdelete_c(int tno,Const char *keyword,int *iostat) -/**hdelete -- Delete an item from a data-set. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - subroutine hdelete(tno,keyword,iostat) - integer tno,iostat - character keyword*(*) - - - This deletes an item from a Miriad data-set. The item must not be "accessed" - when the hdelete routine is called. - - Input: - tno The handle of the data set. - keyword The name of the item. - Output: - iostat I/O status indicator. 0 indicates success. Other values - are standard system error numbers. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - char path[MAXPATH]; - ITEM *item; - TREE *t; - int ent_del; - - if(first)hinit_c(); - - if(tno != 0) if( (*iostat = hname_check((char *)keyword)) ) return; - -/* Check if the item is aleady here abouts. */ - - t = hget_tree(tno); - - ent_del = FALSE; - item = NULL; - if(tno != 0) - for(item=t->itemlist; item != NULL; item = item->fwd) - if(!strcmp(keyword,item->name))break; - -/* Delete the entry for this item, if there was one. */ - - if(item != NULL){ - if(item->flags & ACCESS_MODE) - bugv_c('f',"hdelete: Attempt to delete accessed item: %s",keyword); - if(item->flags & ITEM_CACHE) t->flags |= TREE_CACHEMOD; - hrelease_item_c(item); - ent_del = TRUE; - } - -/* Always try to delete a file associated with the item. */ - - Strcpy(path,t->name); - Strcat(path,keyword); - ddelete_c(path,iostat); - -/* If we have deleted it once already, do not give any errors if the - second attempt failed. */ - - if(ent_del) *iostat = 0; -} -/************************************************************************/ -void haccess_c(int tno,int *ihandle,Const char *keyword,Const char *status,int *iostat) -/**haccess -- Open an item of a data set for access. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - subroutine haccess(tno,itno,keyword,status,iostat) - integer tno,itno,iostat - character keyword*(*),status*(*) - - Miriad data sets consist of a collection of items. Before an item within - a data set can be read/written, etc, it must be "opened" with the haccess - routine. - - Input: - tno The handle of the data set. - keyword The name of the item. - status This can be 'read', 'write', 'append' or 'scratch'. - 'scratch' files are using $TMPDIR, if present, else current. - Output: - itno The handle of the opened item. Note that item handles are - quite distinct from data-set handles. - iostat I/O status indicator. 0 indicates success. Other values - are standard system error numbers. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - char path[MAXPATH]; - ITEM *item; - TREE *t; - int mode=0; - char string[3]; - - if(first)hinit_c(); - - if(!strcmp("read",status)) mode = ITEM_READ; - else if(!strcmp("write",status)) mode = ITEM_WRITE; - else if(!strcmp("scratch",status))mode = ITEM_SCRATCH; - else if(!strcmp("append",status)) mode = ITEM_APPEND; - else bugv_c('f',"haccess_c: unrecognised STATUS=%s",status); - - if(!strcmp("header",keyword) || !strcmp(".",keyword) || - !strcmp("history",keyword)|| tno == 0 || - (mode & ITEM_SCRATCH) )mode |= ITEM_NOCACHE; - - if(tno != 0) if( (*iostat = hname_check((char *)keyword)) )return; - t = hget_tree(tno); - -/* If we are writing, check whether we have write permission. */ - - if( !(mode & ITEM_READ) && !(mode & ITEM_NOCACHE) ){ - if(t->rdwr == RDWR_UNKNOWN)hmode_c(tno,string); - *iostat = t->wriostat; - if(*iostat) return; - } - -/* Check if the item is already here abouts. */ - - item = NULL; - if(tno != 0) - for(item = t->itemlist; item != NULL; item = item->fwd) - if(!strcmp(keyword,item->name))break; - -/* If the item does not exist, create it. Otherwise the item must - be cacheable, in which case we truncate its length to zero if needed. */ - - if(item == NULL)item = hcreate_item_c(t,(char *)keyword); - else if((mode & (ITEM_WRITE|ITEM_SCRATCH)) && item->size != 0){ - item->size = 0; - item->io[0].length = item->io[1].length = 0; - if(item->flags & ITEM_CACHE) t->flags |= TREE_CACHEMOD; - } - -/* Check and set the read/write flags. */ - - if(item->flags & ACCESS_MODE) - bugv_c('f',"haccess_c: Multiple access to item %s",keyword); - item->flags |= mode; - -/* Open the file if necessary. */ - - *iostat = 0; - item->offset = 0; - if(!strcmp(keyword,".")){ - hdir_c(item); - } else if(item->size == 0 && (!(mode & ITEM_WRITE) || (mode & ITEM_NOCACHE)) - && !(item->flags & ITEM_CACHE)){ - Strcpy(path,t->name); - Strcat(path,keyword); - dopen_c(&(item->fd),path,(char *)status,&(item->size),iostat); - - item->bsize = BUFSIZE; - item->io[0].buf = Malloc(BUFSIZE); - if(BUFDBUFF)item->io[1].buf = Malloc(BUFSIZE); - if(mode & ITEM_APPEND) item->offset = item->size; - -/* If we have opened a file in write mode, remember that this dataset is - writeable. */ - - if(!(mode & ITEM_READ)){ - if(*iostat == 0) t->rdwr = RDWR_RDWR; - else t->rdwr = RDWR_RDONLY; - t->wriostat = *iostat; - } - } - *ihandle = item->handle; - if(*iostat)hrelease_item_c(item); -} -/************************************************************************/ -void hmode_c(int tno,char *mode) -/* */ -/**hmode -- Return access modes of a dataset. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - subroutine hmode(tno,mode) - integer tno - character mode*(*) - - Determine the access modes of a data-set - - Input: - tno The handle of the data set. - Output: - mode This will be either "" (unknown access mode), - "r" (read-only) - "rw" (read-write). */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int iostat; - int ihandle; - TREE *t; - -/* If its tno==0, give up. */ - - *mode = 0; - if(tno == 0)return; - -/* If we do not already know the read/write access, determine it the hard - way. */ - - t = hget_tree(tno); - if(t->rdwr == RDWR_UNKNOWN){ - header_ok = TRUE; - haccess_c(tno,&ihandle,"header","append",&iostat); - header_ok = FALSE; - if(!iostat)hdaccess_c(ihandle,&iostat); - } - -/* Return the info. */ - - if(t->rdwr == RDWR_RDONLY) Strcpy(mode,"r"); - else if(t->rdwr == RDWR_RDWR) Strcpy(mode,"rw"); - else bugv_c('f',"hmode_c: Algorithmic failure rdwr=%d",t->rdwr); - -} -/************************************************************************/ -int hexists_c(int tno,Const char *keyword) -/**hexists -- Check if an item exists. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - logical function hexists(tno,keyword) - integer tno - character keyword*(*) - - Check if a particular item exists in a Miriad data-set. - By setting the input 'tno' to 0, one can also check for - existence of any regular file. - - Input: - tno The handle of the data set. 0 also allowed. - keyword The name of the item or filename to check. - Output: - hexists True if the item exists. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - char path[MAXPATH]; - int iostat,fd; - off_t size; - ITEM *item; - TREE *t; - -/* Check for an invalid name. */ - - if(tno != 0) if(hname_check((char *)keyword)) return(FALSE); - -/* Check if the item is aleady here abouts. */ - - if(tno != 0){ /* miriad dataset */ - item = NULL; - t = hget_tree(tno); - for(item = t->itemlist; item != NULL; item = item->fwd) - if(!strcmp(keyword,item->name))return(TRUE); - Strcpy(path,t->name); - Strcat(path,keyword); - } else { - Strcpy(path,keyword); /* regular filename */ - } - -/* It was not found in the items currently opened, nor the items that - live in "header". Now try and open a file with this name. */ - - - dopen_c(&fd,path,"read",&size,&iostat); - if(iostat)return FALSE; - dclose_c(fd,&iostat); - if(iostat != 0)bugv_c('f',"hexists_c: Error closing item %s",keyword); - return TRUE; -} -/************************************************************************/ -void hdaccess_c(int ihandle,int *iostat) -/**hdaccess -- Finish up access to an item. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - subroutine hdaccess(itno,iostat) - integer itno,iostat - - This releases an item. It flushes buffers and waits for i/o to complete. - For small items that are entirely in memory, these are saved until - the whole tree is closed before they are written out. - - Input: - itno The handle of the item to close up. - iostat I/O status indicator. 0 indicates success. Other values - are standard system error numbers. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - ITEM *item; - int i,stat; - -/* If it has an associated file, flush anything remaining to the file - and close it up. */ - - item = hget_item(ihandle); - -/* May be a binary file. Flush modified buffers, wait for i/o to complete, - and close up. */ - - *iostat = 0; - stat = 0; - if(item->fd != 0){ - for(i=0; i<2 && !stat; i++){ - if(item->io[i].state == IO_MODIFIED && !(item->flags & ITEM_SCRATCH)){ - WAIT(item,&stat); - if(!stat)dwrite_c( item->fd, item->io[i].buf, item->io[i].offset, - item->io[i].length, &stat); - item->io[i].state = IO_ACTIVE; - } - } - *iostat = stat; - WAIT(item,&stat); - if(stat) *iostat = stat; - dclose_c(item->fd,&stat); - if(stat) *iostat = stat; - hrelease_item_c(item); - - } else if(item->flags & ITEM_NOCACHE){ - hrelease_item_c(item); - -/* If it has not associated file, it must be small. Do not release it, - as it will need to be written to the cache later on. */ - - } else{ - item->flags &= ~ACCESS_MODE; - if(item->io[0].state == IO_MODIFIED)item->tree->flags |= TREE_CACHEMOD; - item->io[0].state = IO_VALID; - } -} -/************************************************************************/ -off_t hsize_c(int ihandle) -/**hsize -- Determine the size (in bytes) of an item. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - integer function hsize(itno) - integer itno - - This returns the size of an item, in bytes. - - Input: - itno The handle of the item of interest. - Output: - hsize The size of the item in bytes. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - ITEM *item; - item = hget_item(ihandle); - return item->size; -} -/************************************************************************/ -void hio_c(int ihandle,int dowrite,int type,char *buf, - off_t offset, size_t length,int *iostat) -/**hread,hwrite -- Read and write items. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - subroutine hreada(itno,abuf,iostat) - subroutine hreadb(itno,bbuf,offset,length,iostat) - subroutine hreadj(itno,jbuf,offset,length,iostat) - subroutine hreadi(itno,ibuf,offset,length,iostat) - subroutine hreadr(itno,rbuf,offset,length,iostat) - subroutine hreadd(itno,dbuf,offset,length,iostat) - subroutine hwritea(itno,abuf,iostat) - subroutine hwriteb(itno,bbuf,offset,length,iostat) - subroutine hwritej(itno,jbuf,offset,length,iostat) - subroutine hwritei(itno,ibuf,offset,length,iostat) - subroutine hwriter(itno,rbuf,offset,length,iostat) - subroutine hwrited(itno,dbuf,offset,length,iostat) - integer itno,offset,length,iostat - character abuf*(*),bbuf*(length) - integer jbuf(*),ibuf(*) - real rbuf(*) - double precision dbuf(*) - - These routines read and write items of a Miriad data set. They - differ in the sort of element that they read or write. - hreada,hwritea I/O on ascii text data (terminated by newline char). - hreadb,hwriteb I/O on ascii data. - hreadj,hwritej I/O on data stored externally as 16 bit integers. - hreadi,hwritei I/O on data stored externally as 32 bit integers. - hreadr,hwriter I/O on data stored externally as IEEE 32 bit reals. - hreadd,hwrited I/O on data stored externally as IEEE 64 bit reals. - - Note that hreada and hreadb differ in that: - * hreada reads sequentially, terminating a read on a newline character. - The output buffer is blank padded. - * hreadb performs random reads. Newline characters have no special - meaning to it. A fixed number of bytes are read, and the buffer is - not blank padded. - Hwritea and hwriteb differ in similar ways. - - Inputs: - itno The handle of the item to perform I/O on. - offset The byte offset into the item, where I/O is to be - performed. - length The number of bytes to be read. - - "Offset" and "length" are offsets and lengths into the external file, always - given in bytes. - - Note that "offset" and "length" must obey an alignment requirement. Both - must be a multiple of the size of the element they are performing I/O on. - For example, they must be a multiple of 2 for hreadj,hwritej; a multiple - of 4 for hreadi,hwritei,hreadr,hwriter; a multiple of 8 for hreadd,hwrited. - - Inputs(hwrite) or Outputs(hread): - abuf,bbuf,jbuf,ibuf,rbuf,dbuf The buffer containing, or to receive, - the data. - Outputs: - iostat I/O status indicator. 0 indicates success. -1 indicates - end-of-file. Other values are standard system - error numbers. */ -/*-- */ -/*----------------------------------------------------------------------*/ -/* - This performs either a read or write operation. It is somewhat involved, - as it has to handle buffering. Possibly either one or two buffers are - used (system dependent). Read-ahead, write-behind are attempted for - systems which can perform this. - - This is intended to work in both a VMS and UNIX environment, which makes - it quite involved (because of VMS). - - Because of caching of small items, buffers are not allocated until the - last moment. */ - -/* Define a macro to determine if a offset maps into a buffer. */ - -#define WITHIN_BUF(b) ( (item->io[b].length > 0) && \ - (offset >= item->io[b].offset) && \ - (offset < item->io[b].offset + \ - (dowrite ? (off_t)item->bsize : (off_t)item->io[b].length))) - -{ - char *s; - int b; /* 0 or 1, pointing in one of two IOB buffers */ - off_t next, off; - size_t size, len; - IOB *iob1,*iob2; - ITEM *item; - - item = hget_item(ihandle); - size = align_size[type]; - -/* Check various end-of-file conditions and for adequate buffers. */ - - next = offset + (off_t) (!dowrite && type == H_TXT ? 1 : length ); -/* if(!dowrite && type == H_TXT) length = min(length, item->size - offset); */ - *iostat = -1; - if(!dowrite && next > item->size)return; - *iostat = 0; - if(item->bsize < BUFSIZE && (off_t)item->bsize < next)hcheckbuf_c(item,next,iostat); - if(*iostat)return; - -/*----------------------------------------------------------------------*/ -/* */ -/* Loop until we have processed all the data required. */ -/* First determine which of the (possibly) two i/o buffers */ -/* to use. If we have only one buffer, we have no choice. If our */ -/* data is within the last used buffer, use that. Otherwise use */ -/* the least recent used buffer. */ -/* */ -/*----------------------------------------------------------------------*/ - - while(length > 0){ - - b = item->last; - if(item->io[1].buf == NULL) b = 0; - else if(WITHIN_BUF(b)){ - if(WITHIN_BUF(1-b)) b = ( item->io[0].offset > item->io[1].offset ? 0 : 1); - } else b = 1 - b; - iob1 = &(item->io[b]); - iob2 = &(item->io[1-b]); - -/*----------------------------------------------------------------------*/ -/* */ -/* Handle the case of a miss. Flush the i/o buffer if it has been */ -/* modified and read in any needed new data. */ -/* */ -/*----------------------------------------------------------------------*/ - - if(!WITHIN_BUF(b)){ - if(iob1->state == IO_MODIFIED){ - next = iob1->offset + iob1->length; - if(iob1->length%BUFALIGN && next < item->size) - {hwrite_fill_c(item,iob1,next,iostat); if(*iostat) return;} - WAIT(item,iostat); if(*iostat) return; - dwrite_c(item->fd,iob1->buf,iob1->offset,iob1->length,iostat); - iob1->state = IO_ACTIVE; if(*iostat) return; - } - iob1->offset = (offset/BUFALIGN) * BUFALIGN; - iob1->length = 0; - if(!dowrite){ - WAIT(item,iostat); if(*iostat) return; - iob1->length = min((off_t)item->bsize,item->size-iob1->offset); - if(iob2->buf != NULL && iob1->offset < iob2->offset) - iob1->length = min((off_t)iob1->length, iob2->offset - iob1->offset); - dread_c(item->fd,iob1->buf,iob1->offset,iob1->length,iostat); - iob1->state = IO_ACTIVE; if(*iostat) return; - } - } - -/*----------------------------------------------------------------------*/ -/* */ -/* Wait for any i/o and perform a read ahead or write-behind, */ -/* so that we are ready next time. Do this before we copy the */ -/* data to/from the callers buffer, so that we can overlap */ -/* the copy and i/o operations. The next section is skipped if */ -/* the underlying i/o is synchronous. */ -/* */ -/*----------------------------------------------------------------------*/ - -#if BUFDBUFF - if(iob1->state == IO_ACTIVE) - {WAIT(item,iostat); if(*iostat)return;} - - if(iob2->buf != NULL && iob2->state != IO_ACTIVE){ - next = iob1->offset + iob1->length; - -/* Write behind. */ - if(iob2->state == IO_MODIFIED && (!(iob2->length%BUFALIGN) || - iob2->offset + iob2->length == item->size)){ - dwrite_c(item->fd,iob2->buf,iob2->offset,iob2->length,iostat); - iob2->state = IO_ACTIVE; - -/* Read ahead. */ - } else if(!dowrite && next < item->size && next != iob2->offset){ - iob2->offset = next; - iob2->length = min( BUFSIZE, item->size - iob2->offset ); - dread_c (item->fd,iob2->buf,iob2->offset,iob2->length,iostat); - iob2->state = IO_ACTIVE; - } - } -#endif - -/*----------------------------------------------------------------------*/ -/* */ -/* If its a write operation, possibly update the file size, and */ -/* handle possible non-aligned non-sequential write operations. */ -/* */ -/*----------------------------------------------------------------------*/ - - if(dowrite){ - if(iob1->offset + (off_t)iob1->length < offset && - iob1->offset + (off_t)iob1->length < item->size) - {hwrite_fill_c(item,iob1,offset,iostat); if(*iostat) return;} - iob1->state = IO_MODIFIED; - iob1->length = max(iob1->length, - min(length + offset - iob1->offset, item->bsize)); - item->size = max((off_t)item->size,iob1->offset + (off_t)iob1->length); - } - -/*----------------------------------------------------------------------*/ -/* */ -/* Copy between the i/o buffer and users buffer. */ -/* */ -/*----------------------------------------------------------------------*/ - - off = offset - iob1->offset; - len = min(length, iob1->length - off); - s = ( ( off % size ) ? align_buf : iob1->buf + off ); - if(dowrite){ - switch(type){ - case H_BYTE: Memcpy(s,buf,len); - break; - case H_INT: pack32_c((int *)buf, s,len/H_INT_SIZE); - break; - case H_INT2: pack16_c((int2 *)buf,s,len/H_INT2_SIZE); - break; - case H_INT8: pack64_c((int8 *)buf,s,len/H_INT8_SIZE); - break; - case H_REAL: packr_c((float *)buf,s,len/H_REAL_SIZE); - break; - case H_DBLE: packd_c((double *)buf,s,len/H_DBLE_SIZE); - break; - case H_CMPLX: packr_c((float *)buf,s,(2*len)/H_CMPLX_SIZE); - break; - case H_TXT: Memcpy(s,buf,len); - if(*(buf+len-1) == 0)*(iob1->buf+off+len-1) = '\n'; - break; - default: bugv_c('f',"hio_c: Unrecognised write type %d",type); - } - if(off % size) Memcpy(iob1->buf+off,align_buf,len); - } else { - -/* If the data are not aligned, copy to an alignment buffer for processing. */ - - if(off % size) Memcpy(align_buf,iob1->buf+off,len); - switch(type){ - case H_BYTE: Memcpy(buf,s,len); - break; - case H_INT: unpack32_c(s,(int *)buf,len/H_INT_SIZE); - break; - case H_INT2: unpack16_c(s,(int2 *)buf,len/H_INT2_SIZE); - break; - case H_INT8: unpack64_c(s,(int8 *)buf,len/H_INT8_SIZE); - break; - case H_REAL: unpackr_c(s,(float *)buf,len/H_REAL_SIZE); - break; - case H_DBLE: unpackd_c(s,(double *)buf,len/H_DBLE_SIZE); - break; - case H_CMPLX: unpackr_c(s,(float *)buf,(2*len)/H_CMPLX_SIZE); - break; - case H_TXT: len = hfind_nl(s,len); - Memcpy(buf,s,len); - if(*(s+len-1) == '\n'){ - length = len; - *(buf+len-1) = 0; - }else if(offset+(off_t)len == (off_t)item->size && len < length){ - length = ++len; - *(buf+len-1) = 0; - } - break; - default: bugv_c('f',"hio_c: Unrecognised read type %d",type); - } - } - buf += expansion[type] * len; - length -= len; - offset += len; - item->offset = offset; - item->last = b; - } -} -/************************************************************************/ -private int hfind_nl(char *buf, size_t len) -/* - Return the character number of the first new-line character. -------------------------------------------------------------------------*/ -{ - int i; - for(i=1;i <= (int)len; i++)if(*buf++ == '\n')return(i); - return(len); -} -/************************************************************************/ -private void hcheckbuf_c(ITEM *item,off_t next,int *iostat) -/* - Check to determine that we have adequate buffer space, and a file, - if needed. -------------------------------------------------------------------------*/ -{ - char *s,path[MAXPATH]; - TREE *t; - - *iostat = 0; -/* Allocate a small buffer if needed. */ - - if((off_t)item->bsize < next && next <= CACHESIZE){ - s = Malloc(CACHESIZE); - item->bsize = CACHESIZE; - if(item->io[0].length > 0)Memcpy(s,item->io[0].buf,item->io[0].length); - if(item->io[0].buf != NULL) free(item->io[0].buf); - item->io[0].buf = s; - -/* Allocate full sized buffers if needed. */ - - } else if(item->bsize <= CACHESIZE && next > CACHESIZE){ - s = Malloc(BUFSIZE); - item->bsize = BUFSIZE; - if(item->io[0].length > 0)Memcpy(s,item->io[0].buf,item->io[0].length); - if(item->io[0].buf != NULL) free(item->io[0].buf); - item->io[0].buf = s; - if(BUFDBUFF)item->io[1].buf = Malloc(BUFSIZE); - } - -/* Open a file if needed. */ - - if(item->fd == 0 && item->bsize > CACHESIZE && !(item->flags & ITEM_NOCACHE)){ - t = item->tree; - if(item->flags & ITEM_CACHE) t->flags |= TREE_CACHEMOD; - item->flags &= ~ITEM_CACHE; - Strcpy(path,t->name); - Strcat(path,item->name); - dopen_c(&(item->fd),path,"write",&(item->size),iostat); - if(*iostat == 0) t->rdwr = RDWR_RDWR; - else t->rdwr = RDWR_RDONLY; - t->wriostat = *iostat; - } -} -/************************************************************************/ -private void hwrite_fill_c(ITEM *item, IOB *iob, off_t next, int *iostat) -/* - A nonaligned nonsequential write operation has been requested. Read in the - portion that we are missing. We need to fill the i/o buffer up to at - least offset - 1. - - Inputs: - item Descriptor of the thingo we are reading in. - iob Structure of the i/o buffer. - next Fill up to at least byte (next-1). - - Output: - iostat I/O status. -------------------------------------------------------------------------*/ -{ - char buffer[BUFSIZE]; - off_t offset; - size_t length; - - offset = BUFALIGN * ((iob->offset + iob->length) / BUFALIGN); - length = BUFALIGN * ((next-1)/BUFALIGN + 1) - offset; - length = min((off_t)length, (off_t)item->size - offset); - - WAIT(item,iostat); if(*iostat)return; - dread_c(item->fd,buffer,offset,length,iostat); if(*iostat)return; - dwait_c(item->fd,iostat); if(*iostat)return; - offset = iob->offset + iob->length - offset; - length -= offset; - Memcpy(iob->buf+iob->length,buffer+offset,length); - iob->length += length; -} -/************************************************************************/ -void hseek_c(int ihandle,off_t offset) -/**hseek -- Set default offset (in bytes) of an item. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - integer function hseek(itno,offset) - integer itno,offset - - This sets the default access point of an item. This Can be used to - reposition an item when reading/writing using hreada/hwritea. - - Input: - itno The handle of the item of interest. - offset The new offset. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - ITEM *item; - - item = hget_item(ihandle); - item->offset = offset; -} -/************************************************************************/ -off_t htell_c(int ihandle) -/**htell -- Return the default offset (in bytes) of an item. */ -/*&pjt */ -/*:low-level-i/o */ -/*+ FORTRAN call sequence - - integer function htell(itno) - integer itno - - This returns the current default offset of an item, which is used - when reading/writing using hreada/hwritea. - - Input: - itno The handle of the item of interest. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - ITEM *item; - - item = hget_item(ihandle); - return(item->offset); -} -/************************************************************************/ -void hreada_c(int ihandle,char *line,size_t length,int *iostat) -/*----------------------------------------------------------------------*/ -{ - ITEM *item; - - item = hget_item(ihandle); - hio_c( ihandle, FALSE, H_TXT, line, item->offset, length, iostat); -} -/************************************************************************/ -void hwritea_c(int ihandle,Const char *line,size_t length,int *iostat) -/*----------------------------------------------------------------------*/ -{ - ITEM *item; - - item = hget_item(ihandle); - hio_c( ihandle ,TRUE, H_TXT, (char *)line, item->offset, length, iostat); -} -/************************************************************************/ -private void hcache_create_c(TREE *t,int *iostat) -/* - Create a cache. -------------------------------------------------------------------------*/ -{ - int ihandle; - header_ok = TRUE; - haccess_c(t->handle,&ihandle,"header","write",iostat); - header_ok = FALSE; - if(!*iostat) hdaccess_c(ihandle,iostat); -} -/************************************************************************/ -private void hcache_read_c(TREE *t,int *iostat) -/* - Read in all small items, which are stored in the file "header". - Errors should never happen when reading the cache. If they do, - abort completely. -------------------------------------------------------------------------*/ -{ - off_t offset; - ITEM *item; - char s[CACHE_ENT]; - int ihandle; - - header_ok = TRUE; - haccess_c(t->handle,&ihandle,"header","read",iostat); - header_ok = FALSE; if(*iostat)return; - - offset = 0; - while(hreadb_c(ihandle,s,offset,CACHE_ENT,iostat),!*iostat){ - offset += CACHE_ENT; - item = hcreate_item_c(t,s); - item->size = *(s+CACHE_ENT-1); - item->bsize = item->size; - item->flags = ITEM_CACHE; - item->io[0].offset = 0; - item->io[0].length = item->size; - item->io[0].state = IO_VALID; - item->io[0].buf = Malloc(item->size); - hreadb_c(ihandle,item->io[0].buf,offset,item->size,iostat); check(*iostat); - offset += mroundup(item->size,CACHE_ENT); - } - if(*iostat != -1) bug_c('f',"hcache_read_c: Something wrong reading cache"); - hdaccess_c(ihandle,iostat); -} -/************************************************************************/ -private int hname_check(char *name) -/* - This checks if the name of an item is OK. Generally an item must be 1 to - 8 characters, alphanumeric, starting with an alpha. Only lower case - alpha is allowed. The name "header" is generally reserved. -------------------------------------------------------------------------*/ -{ - size_t i, length; - char c; - - length = strlen(name); - if(length <= 0 || length >= MAXNAME) return(-1); - if(length == 1 && *name == '.')return(0); - if(*name < 'a' || *name > 'z')return(-1); - if(!header_ok && length == 6 && !strcmp("header",name))return(-1); - for(i=0; i < length; i++){ - c = *name++; - if((c < 'a' || c > 'z') && (c < '0' || c > '9') && (c != '-') && (c != '_')) - return(-1); - } - return 0 ; -} -/************************************************************************/ -private void hdir_c(ITEM *item) -/* - Read the directory contents into a buffer (make it look like a text - file. -------------------------------------------------------------------------*/ -{ - size_t len, length, plength; - char *context,*s; - ITEM *it; - TREE *t; - -#define MINLENGTH 128 - -/* Mark this item as not cachable. */ - - item->flags |= ITEM_NOCACHE | ITEM_SCRATCH; - -/* Get a buffer size which is guaranteed to hold all the items that come - from the "header" file. */ - - plength = 0; - t = item->tree; - for(it = t->itemlist; it != NULL; it = it->fwd) - plength += strlen(it->name) + 1; - plength = max(plength,2*MINLENGTH); - s = Malloc(plength); - -/* Copy the names of all the "header" items to this buffer. Exclude the "." - itself. */ - - length = 0; - for(it=t->itemlist; it != NULL; it = it->fwd){ - if(it->fd == 0 && !(it->flags & ITEM_NOCACHE)){ - Strcpy(s+length,it->name); - length += strlen(it->name); - *(s+length++) = '\n'; - } - } - -/* Now read through the directory to get all external files. Skip the - "header" file. The size of the buffer is doubled as we go, when it - gets too small. */ - - dopendir_c(&context,t->name); - do{ - if(plength - length < MINLENGTH){ - plength *= 2; - s = Realloc(s, plength); - } - dreaddir_c(context,s+length,plength-length); - len = strlen(s+length); - if(len > 0 && strcmp(s+length,"header")){ - length += len; - *(s+length++) = '\n'; - } - }while(len > 0); - dclosedir_c(context); - -/* Finish initialising the item now. */ - - item->size = length; - item->io[0].buf = s; - item->io[0].offset = 0; - item->io[0].length = length; - item->bsize = plength; -} -/************************************************************************/ -private void hrelease_item_c(ITEM *item) -/* - Release the item on the top of the list. -------------------------------------------------------------------------*/ -{ - ITEM *it1,*it2; - TREE *t; - -/* Find the item. Less than attractive code. */ - - t = item->tree; - it2 = t->itemlist; - if(item != it2){ - do{ - it1 = it2; - it2 = it1->fwd; - }while(item != it2); - - it1->fwd = it2->fwd; - } else t->itemlist = item->fwd; - -/* Release any memory associated with the item. */ - - if(item->io[0].buf != NULL) free(item->io[0].buf); - if(item->io[1].buf != NULL) free(item->io[1].buf); - - item_addr[item->handle] = NULL; - free(item->name); - free((char *)item); - nitem--; -} -/************************************************************************/ -private ITEM *hcreate_item_c(TREE *tree,char *name) -/* - Create an item, and initialise as much of it as possible. -------------------------------------------------------------------------*/ -{ - ITEM *item; - int i,hash; - char *s; - -/* Hash the name. */ - - s = name; - hash = nitem++; - if(nitem > MAXITEM) - bugv_c('f',"Item address table overflow, in hio; nitem=%d MAXITEM=%d",nitem,MAXITEM); - while(*s) hash += *s++; - hash %= MAXITEM; - -/* Find a slot in the list of addresses, and allocate it. */ -/* avoid hash=0 since the hash is returned as a handle and it will */ -/* collide with the special stdout value that MIRIAD often uses */ -/* could also return hash+1 ? but what if this > MAXOPEN */ - - while(hget_item(hash) != NULL || hash==0) hash = (hash+1) % MAXITEM; - item_addr[hash] = (ITEM *)Malloc(sizeof(ITEM)); - -/* Initialise it now. */ - - item = hget_item(hash); - item->name = Malloc(strlen(name) + 1); - Strcpy(item->name,name); - item->handle = hash; - item->size = 0; - item->flags = 0; - item->fd = 0; - item->last = 0; - item->offset = 0; - item->bsize = 0; - item->tree = tree; - for(i=0; i<2; i++){ - item->io[i].offset = 0; - item->io[i].length = 0; - item->io[i].state = 0; - item->io[i].buf = NULL; - } - item->fwd = tree->itemlist; - tree->itemlist = item; - return(item); -} -/************************************************************************/ -private TREE *hcreate_tree_c(char *name) -/* - Create an item, and initialise as much of it as possible. -------------------------------------------------------------------------*/ -{ - TREE *t; - int hash; - char *s; - -/* Hash the name. */ - - s = name; - hash = ntree++; - if(ntree > MAXOPEN) - bugv_c('f',"Tree address table overflow, in hio, ntree=%d MAXOPEN=%d",ntree,MAXOPEN); - while(*s) hash += *s++; - hash %= MAXOPEN; - -/* Find a slot in the list of addresses, and allocate it. */ - - while(hget_tree(hash) != NULL || hash==0) hash = (hash+1) % MAXOPEN; - tree_addr[hash] = (TREE *)Malloc(sizeof(TREE)); - -/* Initialise it. */ - - t = hget_tree(hash); - t->name = Malloc(strlen(name) + 1); - Strcpy(t->name,name); - t->handle = hash; - t->flags = 0; - t->itemlist = NULL; - return t; -} Index: casacore-3.5.0/mirlib/hio.h =================================================================== --- casacore-3.5.0.orig/mirlib/hio.h +++ /dev/null @@ -1,48 +0,0 @@ -#if !defined(MIR_HIO_H) -#define MIR_HIO_H - -#include "sysdep.h" - -/* - * magic numbers at the start of an item, these are like BITPIX in fits, - * so don't change them or your MIRIAD files won't be exchangeable between - * other MIRIAD implementations - * MAXTYPES is pretty arbitrary, just make sure it's at least the last H_<type>+1 - * - */ - -#define H_BYTE 1 -#define H_INT 2 -#define H_INT2 3 -#define H_REAL 4 -#define H_DBLE 5 -#define H_TXT 6 -#define H_CMPLX 7 -#define H_INT8 8 - -#define MAXTYPES 10 - -#define H_BYTE_SIZE 1 -#define H_INT_SIZE 4 -#define H_INT2_SIZE 2 -#define H_INT8_SIZE 8 -#define H_REAL_SIZE 4 -#define H_DBLE_SIZE 8 -#define H_TXT_SIZE 1 -#define H_CMPLX_SIZE 8 - -#define MAXPATH 256 -#define MAXOPEN 26 - - -/* prototypes are now in miriad.h (mostly) and sysdep.h (pack routines) */ - -/* Other handy definitions. */ - -#define TRUE 1 -#define FALSE 0 -#define max(a,b) ((a)>(b)?(a):(b)) -#define min(a,b) ((a)<(b)?(a):(b)) -#define mroundup(a,b) ((b)*(((a)+(b)-1)/(b))) - -#endif /* MIR_HIO_H */ Index: casacore-3.5.0/mirlib/io.h =================================================================== --- casacore-3.5.0.orig/mirlib/io.h +++ /dev/null @@ -1,56 +0,0 @@ -/************************************************************************/ -/* */ -/* A general header file for the various file and i/o handling */ -/* routines. */ -/* */ -/* History: */ -/* rjs Dark-ages Original version. */ -/* rjs 20aug92 Correct "roundup" macro when rounding 0. */ -/* rjs 15may96 Moved roundup macro elsewhere. */ -/* pjt 28may02 Added H_INT8 */ -/* pjt 17jun02 different MIR4 structures? */ -/************************************************************************/ - -/* Binary items start with a sequence to allow routines to blindly determine - how to read them. The "binary_item" is a catch all with only indicates - that the data is binary valued, but does not hint at the format. */ - -#if !defined(MIR_IO_H) -#define MIR_IO_H - -#include "hio.h" -#include <unistd.h> - -#define ITEM_HDR_SIZE 4 - -#if 1 - -/* MIRIAD3 and below data structures */ - - -static char binary_item[ITEM_HDR_SIZE] = {0,0,0,0}, - real_item[ITEM_HDR_SIZE] = {0,0,0,H_REAL}, - int_item[ITEM_HDR_SIZE] = {0,0,0,H_INT}, - int2_item[ITEM_HDR_SIZE] = {0,0,0,H_INT2}, - int8_item[ITEM_HDR_SIZE] = {0,0,0,H_INT8}, - char_item[ITEM_HDR_SIZE] = {0,0,0,H_BYTE}, - dble_item[ITEM_HDR_SIZE] = {0,0,0,H_DBLE}, - cmplx_item[ITEM_HDR_SIZE] = {0,0,0,H_CMPLX}; - -#else - -/* MIRIAD4 data structures - not finalized on this though */ - -static char binary_item[ITEM_HDR_SIZE] = {1,0,0,0}, - real_item[ITEM_HDR_SIZE] = {1,0,0,H_REAL}, - int_item[ITEM_HDR_SIZE] = {1,0,0,H_INT}, - int2_item[ITEM_HDR_SIZE] = {1,0,0,H_INT2}, - int8_item[ITEM_HDR_SIZE] = {1,0,0,H_INT8}, - char_item[ITEM_HDR_SIZE] = {1,0,0,H_BYTE}, - dble_item[ITEM_HDR_SIZE] = {1,0,0,H_DBLE}, - cmplx_item[ITEM_HDR_SIZE] = {1,0,0,H_CMPLX}; - - -#endif - -#endif /* MIR_IO_H */ Index: casacore-3.5.0/mirlib/key.c =================================================================== --- casacore-3.5.0.orig/mirlib/key.c +++ /dev/null @@ -1,968 +0,0 @@ -/*********************************************************************** - * - * Key routines provide keyword-oriented access to the command line. - * - * History: - * rjs 24apr91 Original version. - * jm 28jun94 Wrote the ANSI-C version. - * jm 01nov94 Added expand and local traits and added keyl(). - * jm 17nov94 Rewrote #if definitions for ANSI prototypes. Sun - * machines define __STDC__ even when it is 0! This - * involved creating and using PROTOTYPE in sysdep.h. - * jm 24oct96 Increased MAXSTRING from 256 to 512 and fixed a - * few lint complaints. - * jm 01aug97 Changed getKeyValue to properly handle single and - * double quotes around a value. - * pjt 03sep98 fixed malloc(size+1) bug with interesting side-effects - * on linux and HP-UX - * pjt 5aug99 increased MAXSTRING to 1024 (also do keyf.f !!!) - * pjt 6mar01 increased MAXSTRING to 2048 - * mchw 15mar02 increased MAXSTRING to 4096 - * pjt 22jun02 MIR4 prototypes, also added a few more Const - * jwr 22jul04 changed a few vars from size_t to ssize_t, since signed - * arithmetic is required. Also made failure of wildcard - * expansion fatal (it would crash later if only a warning - * is given) - * pjt 13jul07 make unique messages in different pieces of code - * pjt 12jun10 added keyputc_c for ATNF compatibility - * dm/pjt 2dec10 better protection for keyword values overrun - * keywrap.f2c is now calling keya_len_c() instead - * deprecate keya_c() - * pjt 21jul11 keyl_c() now calls keya_len_c() - *********************************************************************** - */ - -#if defined(HAVE_CONFIG_H) && HAVE_CONFIG_H -#include "config.h" -#endif - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <ctype.h> -#include <math.h> -#include "miriad.h" - -#ifndef Null -#define Null '\0' -#endif - -/* if you change MAXSTRING, also do keyf.for */ -#define KEYTRUE 1 -#define KEYFALSE 0 -#define MAXSTRING 4096 - -typedef struct ckeys { - char *key; /* Pointer to a malloc'd string holding the key name. */ - char *Pvalue; /* Pointer to a malloc'd string holding the value. */ - char *value; /* Pointer to current spot in Pvalue. */ - int isexpanded; /* False if not yet expanded; true otherwise. */ - int islocal; /* True if defined locally; false if globally. */ - struct ckeys *fwd; /* Pointer to next ckey structure. */ -} KEYS; - -static KEYS *KeyHead = (KEYS *)NULL; - - /* This will be set to KEYTRUE only when keyini[_c]() is called. */ -static int iniCalled = KEYFALSE; - -/***********************************************************************/ -static char *skipLeading(Const char *string) -{ - char *ptr; - - if (string == (Const char *)NULL) - return((char *)NULL); - - for (ptr = (char *)string; ((*ptr != Null) && isspace(*ptr)); ptr++) - /* NULL */ ; - - return(ptr); -} - -/***********************************************************************/ -static KEYS *getKey(Const char *key) -{ - char *ptr; - KEYS *t; - - /* First, check that the key routines have been initialized. */ - if (iniCalled == KEYFALSE) { - (void)bug_c('f', "The Key initialization routine must be called first."); - } - /* - * Search for a key by name. If the key name is not found, - * return a NULL pointer. Otherwise, return a pointer to the - * private structure of the key. - */ - if ((ptr = skipLeading(key)) == (char *)NULL) - return((KEYS *)NULL); - - for (t = KeyHead; t != (KEYS *)NULL; t = t->fwd) - if (strcmp(ptr, t->key) == 0) - break; - - return(t); -} - -/***********************************************************************/ -static char *getKeyValue(Const char *key, int doexpand) -{ - char *r, *s; - char quoted; - char string[MAXSTRING]; - int more; - ssize_t size, depth; - KEYS *t; - FILE *fp; - - if ((t = getKey(key)) == (KEYS *)NULL) - return((char *)NULL); - if ((t->value == (char *)NULL) || (*(t->value) == Null)) - return((char *)NULL); - /* - * At this point, there is a value to return. Scan through to - * the end of the parameter value. - */ - r = s = skipLeading(t->value); - depth = 0; - more = KEYTRUE; - quoted = Null; /* Initially, not in a quoted string. */ - while ((*s != Null) && (more == KEYTRUE)) { - if (quoted == Null) { /* Not currently within a quote. */ - if ((*s == '"') || (*s == '\'')) { - quoted = *s; /* Set this to the char that ends the quote. */ - } else { - if (*s == '(') depth++; - else if (*s == ')') depth--; - else if (isspace(*s) || (*s == ',')) - more = (depth == 0) ? KEYFALSE : KEYTRUE; - } - } else if (*s == quoted) { /* Inside a quote; read till matched. */ - quoted = Null; /* Reset this to mean not in a quote. */ - } - if (more == KEYTRUE) s++; - } - t->value = (*s == Null) ? s : s + 1; - *s-- = Null; /* Subtract 1 from index for following test. */ - - /* Remove leading and trailing quotes. */ - if ((*r != Null) && (s > r)) { - if (((*r == '"') && (*s == '"')) || ((*r == '\'') && (*s == '\''))) { - *s = Null; - r++; - } - } - /* - * If the value starts with a '@' character, then open the - * given file name and store each line as a comma separated list. - * Next, if there is anything left in the keyword value list, - * add it to the end of the newly generated list. Finally, re-call - * this routine to read the first parameter off the new list. - */ - if (*r == '@') { - r++; - if ((fp = fopen(r, "r")) == (FILE *)NULL) { - (void)sprintf(string, "Error opening @ file [%s].", r); - (void)bug_c('f', string); - } - - more = KEYTRUE; - while (fgets(string, MAXSTRING, fp) != (char *)NULL) { - if (((size = strlen(string)) > (size_t)0) && (string[size-1] == '\n')) - string[size-1] = Null; - - r = skipLeading(string); - if ((r == (char *)NULL) || (*r == Null) || (*r == '#')) - continue; - - if (more == KEYTRUE) { - depth = strlen(r) + 1; - if ((s = (char *)malloc(depth)) == (char *)NULL) - (void)bug_c('f', "Could not allocate memory in the key routines."); - (void)strcpy(s, r); - more = KEYFALSE; - } else { - depth += strlen(r) + 2; - if ((s = (char *)realloc(s, depth)) == (char *)NULL) - (void)bug_c('f', "Could not allocate memory in the key routines."); - (void)strcat(s, ","); - (void)strcat(s, r); - } - } - - (void)fclose(fp); - - if (depth == 0) - (void)bug_c('f', "Trouble processing the @ directive."); - - if (*(t->value) != Null) { - depth += strlen(t->value) + 2; - if ((s = (char *)realloc(s, depth)) == (char *)NULL) - (void)bug_c('f', "Could not allocate memory in the key routines."); - (void)strcat(s, ","); - (void)strcat(s, t->value); - } - - (void)free((Void *)t->Pvalue); - t->value = t->Pvalue = s; - t->isexpanded = KEYTRUE; - r = getKeyValue(key, doexpand); - } else if ((doexpand == KEYTRUE) && (t->isexpanded == KEYFALSE)) { - /* - * Otherwise, if expansion is desired and the keyword has not - * yet been expanded, call the dio.c routine dexpand_c() to - * return the result of the system call to "echo r". - */ - size = dexpand_c(r, string, MAXSTRING); - if (size < 1) { - (void)sprintf(string, "Error doing wildcard expansion of [%s].", r); - (void)bug_c('f', string); - } else { - if (*(t->value) != Null) - size += strlen(t->value) + 2; - if ((s = (char *)malloc(size+1)) == (char *)NULL) - (void)bug_c('f', "Could not allocate memory in the key routines."); - (void)strcpy(s, string); - if (*(t->value) != Null) { - (void)strcat(s, ","); - (void)strcat(s, t->value); - } - (void)free((Void *)t->Pvalue); - t->value = t->Pvalue = s; - t->isexpanded = KEYTRUE; - } - r = getKeyValue(key, doexpand); - } - - return((*r == Null) ? (char *)NULL : r); -} - -/***********************************************************************/ -void keyinit_c(Const char *task) -{ - buglabel_c(task); /* Let the bug routines know the task name. */ - iniCalled = KEYTRUE; /* Is True only when keyini[_c]() is called. */ -} - -/* hack to be able to use the ATNF fortran subroutine keyputc */ - -void keyputc_c(char *string) -{ - keyput_c("unknown", string); -} -/***********************************************************************/ -void keyput_c(Const char *task, char *string) -/** KeyPut -- Store a keyword for later retrieval. */ -/*& pjt */ -/*: user-input,command-line */ -/*+ FORTRAN call sequence: - - subroutine keyput(task,value) - character task*(*),value*(*) - - This task stores the keyword=value pair for later retrieval by the - other key routines. If the keyword has previously been saved prior - to calling this routine, then this version will only be saved if - (1) the previous was not defined locally (ie. task/keyword) or - (2) this reference is also a local reference. - - If the keyword is locally defined (ie. task/keyword) but the task - name does not match the value of the input string task, then the - keyword is not (ever) saved. - - NOTE: This is an internal routine that is only called by KeyIni. - - Input: - task The name of the current task. - value The keyword=value pair. - - Output: - (none) - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - char *s, *key; - char *pequal, *pslash; - char errmsg[MAXSTRING]; - int localkey; - KEYS *t; - - if (iniCalled == KEYFALSE) { - (void)bug_c('f', - "The Key initialization routine must be called before calling KEYPUT."); - } - - if (((s = skipLeading(string)) == (char *)NULL) || (*s == Null)) { - (void)sprintf(errmsg, "Badly formed parameter-1: [%s].", string); - (void)bug_c('w', errmsg); - return; - } else if (*s == '#') { /* Quietly return on comment lines. */ - return; - } - - key = s; /* Get the key name. */ - while ((*s != Null) && (isalnum(*s) || (*s == '$'))) - s++; - if (*s == Null) { - (void)sprintf(errmsg, "Badly formed parameter-2: [%s].", string); - (void)bug_c('w', errmsg); - return; - } - /* - * Search for the local keyword character (/). If it exists, - * it must appear before the equal sign with text that precedes - * and follows it. If the key is local, the key and value will - * be saved only if the task name matches the text before the - * local flag character. - */ - localkey = KEYFALSE; - if (((pslash = strchr(s, '/')) != (char *)NULL) && - ((pequal = strchr(s, '=')) != (char *)NULL) && - (pslash < pequal)) { - *s = Null; /* Terminate the task name. */ - if (strcmp(task, key) != 0) /* This keyword doesn't match task. */ - return; - s = skipLeading(pslash+1); /* Skip blanks after the local char. */ - - localkey = KEYTRUE; - key = s; /* Now, get the real [local] key name. */ - while ((*s != Null) && (isalnum(*s) || (*s == '$'))) s++; - if (*s == Null) { - (void)sprintf(errmsg, "Badly formed parameter-3: [%s].", string); - (void)bug_c('w', errmsg); - return; - } - } - *s++ = Null; /* Properly terminate the keyword. */ - - /* Now move to the value part of this keyword. */ - while ((*s != Null) && (isspace(*s) || (*s == '='))) - s++; - if ((*s == Null) || (strlen(s) < (size_t)1)) { - (void)sprintf(errmsg, "Badly formed parameter-4: [%s=%s].", key, string); - (void)bug_c('w', errmsg); - return; - } - /* - * See if this keyword already exists. If not, then create it. - * If it exists and was not previously declared local, then - * this version will override the previous reference of the key. - * If this reference was previously defined locally then only - * another local reference will override it. - */ - for (t = KeyHead; t != (KEYS *)NULL; t = t->fwd) { - if (strcmp(key, t->key) == 0) - break; - } - - if (t == (KEYS *)NULL) { - if ((t = (KEYS *)malloc(sizeof(KEYS))) == (KEYS *)NULL) - (void)bug_c('f', "Could not allocate memory in the key routines."); - if ((t->key = (char *)malloc(strlen(key) + 1)) == (char *)NULL) - (void)bug_c('f', "Could not allocate memory in the key routines."); - (void)strcpy(t->key, key); - t->fwd = KeyHead; - KeyHead = t; - } else if ((localkey == KEYTRUE) || (t->islocal != KEYTRUE)) { - if (t->Pvalue != (char *)NULL) - (void)free((Void *)t->Pvalue); - } else { - return; - } - - if ((t->Pvalue = (char *)malloc(strlen(s) + 1)) == (char *)NULL) - (void)bug_c('f', "Could not allocate memory in the key routines."); - (void)strcpy(t->Pvalue, s); - t->value = t->Pvalue; - t->isexpanded = KEYFALSE; - t->islocal = localkey; - - return; -} - -/***********************************************************************/ -void keyini_c(int argc, char *argv[]) -/** KeyIni_c -- Initialise the `key' routines (C version). */ -/*& pjt */ -/*: user-input, command-line */ -/*+ - - void keyini_c(int argc, char *argv[]) - - Keyini_c performs some initial parsing of the command line breaking - it up into its keyword=value pairs. It also stores the name of - the program (which is currently only used by the bug routines). - - NOTE: This has a different calling sequence than the Fortran - version. - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - char *task; - char string[MAXSTRING]; - register int i; - size_t size; - FILE *fp; - /* - * Get the program name, and tell the bug routines what it - * really is. Then strip off any leading path characters - * so only the task name remains. - */ - keyinit_c(argv[0]); - task = argv[0] + strlen(argv[0]) - 1; - while ((task > argv[0]) && (strchr("]/", task[-1]) == (char *)NULL)) - task--; - - for (i = 1; i < argc; i++) { - if (strcmp("-f", argv[i]) == 0) { /* Read args from a file. */ - if (++i >= argc) - (void)bug_c('f', "KeyIni: No parameter file given for -f option."); - - if ((fp = fopen(argv[i], "r")) == (FILE *)NULL) { - (void)sprintf(string, - "KeyIni: Failed to open the parameter file [%s].", argv[i]); - (void)bug_c('f', string); - } - - while (fgets(string, MAXSTRING, fp) != (char *)NULL) { - if (((size = strlen(string)) > (size_t)0) && (string[size-1] == '\n')) - string[size-1] = Null; - keyput_c(task, string); - } - - (void)fclose(fp); - } else if (strcmp("-?", argv[i]) == 0) { /* Give help. */ - (void)sprintf(string, "mirhelp %s", task); - (void)system(string); - (void)exit(0); - } else if (strcmp("-k", argv[i]) == 0) { /* List the keywords. */ - (void)sprintf(string, "doc %s", task); - (void)system(string); - (void)exit(0); - } else if (argv[i][0] == '-') { /* Others not understood yet. */ - (void)sprintf(string, "KeyIni: Flag [%s] not understood.", argv[i]); - (void)bug_c('w', string); - } else { /* Otherwise, the argument is a parameter. */ - keyput_c(task, argv[i]); - } - } - return; -} - -/***********************************************************************/ -void keyfin_c(void) -/** KeyFin -- Finish access to the 'key' routines. */ -/*& pjt */ -/*: user-input,command-line */ -/*+ FORTRAN call sequence: - - subroutine keyfin - - A call to KeyFin indicates that all of the parameters that the - program wants have been retrieved from the command line. KeyFin - makes sure all command line parameters have been read. - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - char errmsg[MAXSTRING]; - KEYS *t, *next; - - if (iniCalled == KEYFALSE) { - (void)bug_c('f', - "The Key initialization routine must be called before calling KEYFIN."); - } - - next = (KEYS *)NULL; - for (t = KeyHead; t != (KEYS *)NULL; t = next) { - next = t->fwd; - if ((t->value != (char *)NULL) && (*(t->value) != Null)) { - (void)sprintf(errmsg, "Keyword [%s] not used or not exhausted.", - t->key); - (void)bug_c('w', errmsg); - } - - if (t->Pvalue != (char *)NULL) - (void)free((Void *)t->Pvalue); - if (t->key != (char *)NULL) - (void)free((Void *)t->key); - (void)free((Void *)t); - } - - KeyHead = (KEYS *)NULL; - iniCalled = KEYFALSE; - return; -} - -/***********************************************************************/ -/* Returns FORT_TRUE if keyword is present; FORT_FALSE otherwise. */ -int keyprsnt_c(Const char *keyword) -/** KeyPrsnt -- Determine if a keyword is present on the command line. */ -/*& pjt */ -/*: user-input,command-line */ -/*+ FORTRAN call sequence: - - logical function keyprsnt(key) - character key*(*) - - Determine if a parameter is still present. - - Input: - key The keyword to check. - - Output: - keyprsnt Is .TRUE. if the keyword is present; .FALSE. otherwise. - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - int isPresent; - KEYS *t; - - t = getKey(keyword); - isPresent = ((t != (KEYS *)NULL) && - (t->value != (char *)NULL) && - (*(t->value) != Null)) ? FORT_TRUE : FORT_FALSE; - - return(isPresent); -} - -/***********************************************************************/ -void keya_c(Const char *keyword, char *value, Const char *keydef) -/** Keya -- Retrieve a character string from the command line. */ -/*& pjt */ -/*: user-input,command-line */ -/*+ FORTRAN call sequence: - - subroutine keya(key,value,default) - character key*(*) - character value*(*),default*(*) - - Retrieve a character string from the command line. If the keyword - is not found, the default is returned. - - Input: - key The name of the keyword to return. - default The default value to return if the keyword is not - present on the command line. - Output: - value The returned value. - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - char *s; - - bugv_c ('w', "KeyA: keyword \"%s\" length not checked", keyword); - - s = getKeyValue(keyword, KEYFALSE); - (void)strcpy(value, ((s == (char *)NULL) ? keydef : s)); - return; -} - -void keya_len_c(Const char *keyword, char *value, size_t vlen, Const char *keydef) -{ - char *s; - - s = getKeyValue(keyword, KEYFALSE); - - if (s && strlen (s) > vlen) - bugv_c ('f', "KeyA: value \"%s\" of keyword \"%s\" is doesn\'t fit in its " - "Fortran buffer, which is only %zd bytes.", s, keyword, vlen); - if ((s==(char *)NULL) && strlen(keydef) > vlen) - bugv_c ('f', "KeyA: default value \"%s\" of keyword \"%s\" is would not fit in its " - "Fortran buffer, which is only %zd bytes.", keydef, keyword, vlen); - - (void)strncpy(value, ((s == (char *)NULL) ? keydef : s), vlen); - return; -} - -/***********************************************************************/ -void keyf_c(Const char *keyword, char *value, Const char *keydef) -/** Keyf -- Retrieve a file name (with wildcards) from the command line. */ -/*& pjt */ -/*: user-input,command-line */ -/*+ FORTRAN call sequence: - - subroutine keyf(key,value,default) - character key*(*) - character value*(*),default*(*) - - Retrieve a character string from the command line. If the keyword - is not found, the default is returned. - - Input: - key The name of the keyword to return. - default The default value to return if the keyword is not - present on the command line. - Output: - value The returned value. - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - char *s; - - /* Expand any wildcards and match them with files. */ - s = getKeyValue(keyword, KEYTRUE); - (void)strcpy(value, ((s == (char *)NULL) ? keydef : s)); - return; -} - -/***********************************************************************/ -void keyd_c(Const char *keyword, double *value, Const double keydef) -/** Keyd -- Retrieve a double precision from the command line. */ -/*& pjt */ -/*: user-input,command-line */ -/*+ FORTRAN call sequence: - - subroutine keyd(key,value,default) - character key*(*) - double precision value,default - - Retrieve a double precision value from the command line. If the - keyword is not found, the default is returned. - - Input: - key The name of the keyword to return. - default The default value to return, if the keyword is not - present on the command line. - Output: - value The returned value. - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - char *s, *ptr; - char errmsg[MAXSTRING]; - - *value = keydef; - if ((s = getKeyValue(keyword, KEYFALSE)) == (char *)NULL) - return; - - ptr = (char *)NULL; - *value = strtod(s, &ptr); - if (s == ptr) { - (void)sprintf(errmsg, - "KeyD: Conversion error decoding parameter [%s=%s].", keyword, s); - (void)bug_c('f', errmsg); - } - - return; -} - -/***********************************************************************/ -void keyr_c(Const char *keyword, float *value, Const float keydef) -/** Keyr -- Retrieve a real value from the command line. */ -/*& pjt */ -/*: user-input,command-line */ -/*+ FORTRAN call sequence: - - subroutine keyr(key,value,default) - character key*(*) - real value,default - - Retrieve a real value from the command line. If the keyword is - not found, the default is returned. - - Input: - key The name of the keyword to return. - default The default value to return, if the keyword is not - present on the command line. - Output: - value The returned value. - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - double retval, defval; - - defval = keydef; - keyd_c(keyword, &retval, defval); - *value = retval; - return; -} - -/***********************************************************************/ -void keyi_c(Const char *keyword, int *value, Const int keydef) -/** Keyi -- Retrieve an integer from the command line. */ -/*& pjt */ -/*: user-input,command-line */ -/*+ FORTRAN call sequence: - - subroutine keyi(key,value,default) - character key*(*) - integer value,default - - Retrieve an integer from the command line. If the keyword is - not found, the default is returned. The integer can be input - as a hexadecimal, octal or decimal number using a prefix 0x, %x - or h for hex; o or %o for octal; and +, - or nothing for decimal. - - Input: - key The name of the keyword to return. - default The default value to return, if the keyword is not - present on the command line. - Output: - value The returned value. - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - char *s, *ptr; - char temp[MAXSTRING]; - int iarg, dummy; - double dval; - - *value = keydef; - if ((s = getKeyValue(keyword, KEYFALSE)) == (char *)NULL) - return; - /* - * This business is done instead of a call to strtol because - * hexadecimal and octal are also acceptable integer inputs. - */ - (void)sprintf(temp, "%s~~1", s); - if ((sscanf(temp, "%i~~%d", &iarg, &dummy) == 2) && (dummy == 1)) { - *value = iarg; /* Token was just a simple integer. */ - return; - } - - /* Number is floating point; find it and then take nint(). */ - ptr = (char *)NULL; - dval = strtod(s, &ptr); - if (s == ptr) { - (void)sprintf(temp, - "KeyI: Conversion error decoding parameter [%s=%s].", keyword, s); - (void)bug_c('f', temp); - } - *value = (dval >= 0) ? floor(dval + 0.5) : ceil(dval - 0.5); - - return; -} - -/***********************************************************************/ -void keyl_c(Const char *keyword, int *value, Const int keydef) -/** keyl -- Retrieve a logical value from the command line. */ -/*& pjt */ -/*: user-input,command-line */ -/*+ FORTRAN call sequence: - - subroutine keyl(key,value,default) - character key*(*) - logical value,default - - Retrieve a logical value from the command line. If the keyword is - not found, the default is returned. It associates (case - insensitive) words starting with 'y', 't' and '1' as .TRUE. and - words starting with 'n', 'f' and '0' as .FALSE. Values of .TRUE. - and .FALSE. are also detected... both with minimum match. - - Input: - key The name of the keyword to return. - default The default value to return, if the keyword is not - present on the command line. - Output: - value The returned value. - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - char string[MAXSTRING]; - char errmsg[MAXSTRING]; - int state; - - if (keydef == FORT_FALSE) { - keya_len_c(keyword, string, MAXSTRING, "f"); - state = KEYFALSE; - } else { - keya_len_c(keyword, string, MAXSTRING, "t"); - state = KEYTRUE; - } - - (void)sprintf(errmsg, "KeyL: invalid value for a logical: [%s].", string); - switch ((int)string[0]) { - case 'f': case 'F': case 'n': case 'N': case '0': - state = KEYFALSE; - break; - case 't': case 'T': case 'y': case 'Y': case '1': - state = KEYTRUE; - break; - case '.': - switch ((int)string[1]) { - case 'f': case 'F': - state = KEYFALSE; - break; - case 't': case 'T': - state = KEYTRUE; - break; - default: - (void)bug_c('w', errmsg); - break; - } - break; - default: - (void)bug_c('w', errmsg); - break; - } - - *value = (state == KEYTRUE) ? FORT_TRUE : FORT_FALSE; - return; -} - -/***********************************************************************/ -/* - * The following macro is used by all of the subsequent multi-get - * routines. It assumes that: - * - * Const char *keyword is the name of the key to retrieve; - * T value[] is the array to receive each returned value; - * int nmax is the maximum number of items to get; and - * int *n is the number of items returned; - * - * where T is the type of the variable (char *, double, float, or int). - * - * In the macro below, - * task is the name of the individual item retrieval task; - * defval is the default value to be used if the keyword is missing; and - * name is a string representing the task name (to be used in - * an error message. - * - * The do {} while (1==0) construct is done so that the macro may - * be called like a regular subroutine. - */ -#define MULTIGET(task,defval,name) \ - do { \ - char errmsg[MAXSTRING]; \ - register int count = 0; \ - \ - while ((count < nmax) && (keyprsnt_c(keyword) == FORT_TRUE)) \ - task(keyword, &value[count++], defval); \ - \ - if (keyprsnt_c(keyword) == FORT_TRUE) { \ - (void)sprintf(errmsg, "%s: Buffer overflow for keyword [%s].", \ - name, keyword); \ - (void)bug_c('f', errmsg); \ - } \ - \ - *n = count; \ - } while (1==0) - -/***********************************************************************/ -void mkeyd_c(Const char *keyword, double value[], Const int nmax, int *n) -/** MKeyd -- Retrieve multiple double values from the command line. */ -/*& pjt */ -/*: user-input,command-line */ -/*+ FORTRAN call sequence: - - subroutine mkeyd(key,value,nmax,n) - integer nmax, n - character key*(*) - double precision value(nmax) - - Retrieve multiple double precision values from the command line. - If the keyword is not found, then zero values are returned. - - Input: - key The name of the keyword to return. - nmax The maximum number of values to return - - Output: - n The number of values returned. - value The returned values - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - MULTIGET(keyd_c, 0.0, "MKeyD"); - return; -} - -/***********************************************************************/ -void mkeyr_c(Const char *keyword, float value[], Const int nmax, int *n) -/** MKeyr -- Retrieve multiple real values from the command line. */ -/*& pjt */ -/*: user-input,command-line */ -/*+ FORTRAN call sequence: - - subroutine mkeyr(key,value,nmax,n) - integer nmax, n - character key*(*) - real value(nmax) - - Retrieve multiple real values from the command line. If the keyword - is not found, then zero values are returned. - - Input: - key The name of the keyword to return. - nmax The maximum number of values to return - - Output: - n The number of values returned. - value The returned values - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - MULTIGET(keyr_c, 0.0, "MKeyR"); - return; -} - -/***********************************************************************/ -void mkeyi_c(Const char *keyword, int value[], Const int nmax, int *n) -/** MKeyi -- Retrieve multiple integer values from the command line. */ -/*& pjt */ -/*: user-input,command-line */ -/*+ FORTRAN call sequence: - - subroutine mkeyi(key,value,nmax,n) - integer nmax, n - character key*(*) - integer value(nmax) - - Retrieve multiple integer values from the command line. If the - keyword is not found, then zero values are returned. - - Input: - key The name of the keyword to return. - nmax The maximum number of values to return - - Output: - n The number of values returned. - value The returned values - */ -/*--*/ -/*---------------------------------------------------------------------*/ -{ - MULTIGET(keyi_c, 0, "MKeyI"); - return; -} - -#ifdef TESTBED -/***********************************************************************/ -int main(int argc, char *argv[]) -{ - char aval[100]; - register int i; - int ival; - float fval; - double cnt[5]; - - keyini_c(argc, argv); - mkeyd_c("cnt", cnt, 5, &ival); - for (i = 0; i < ival; i++) - (void)printf("cnt[%d] = %g\n", i+1, cnt[i]); - for (i = 0; i < 5; i++) { - keyi_c("alpha", &ival, 100); - (void)printf("Alpha[100] = %d ", ival); - keya_c("beta", aval, "def-val"); - (void)printf("Beta[def-val] = %s ", aval); - keyr_c("gamma", &fval, 10.0); - (void)printf("Gamma[10.0] = %g\n", fval); - } - keyfin_c(); - (void)exit(0); -} -#endif Index: casacore-3.5.0/mirlib/maskio.c =================================================================== --- casacore-3.5.0.orig/mirlib/maskio.c +++ /dev/null @@ -1,450 +0,0 @@ -/************************************************************************/ -/* */ -/* A package of routines to read and write masks (bitmaps) */ -/* These are used by MIRIAD for data flagging and blanking. */ -/* */ -/* Masks are implemented as integer data items. The 32nd */ -/* bit in the integer is not used, as this could cause */ -/* portability problems. As it is, this software assumes that */ -/* the host integer is at least 32 bits long. */ -/* */ -/* History: */ -/* rjs Dark-ages Original version. */ -/* rjs 6nov89 Does not abort if the mask file is missing. */ -/* rjs 3mar93 Make mkflush a user-callable routine. */ -/* rjs 23dec93 Do not open in read/write mode unless necessary. */ -/* rjs 6nov94 Change item handle to an integer. */ -/* rjs 19apr97 Handle FORTRAN LOGICALs better. Some tidying. */ -/* rjs 03jan05 Tidying. */ -/* pjt 7jan10 yes, and fixed 64bit offsets (not lengths!!!) */ -/* pjt feb12 added masking support, getmaski,setmaski */ -/************************************************************************/ - -#if defined(HAVE_CONFIG_H) && HAVE_CONFIG_H -#include "config.h" -#endif - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include "miriad.h" -/* #include "io.h" */ - -#define BUG(sev,a) bug_c(sev,a) -#define ERROR(sev,a) bug_c(sev,((void)sprintf a,message)) -#define CHECK(x) if(x) bugno_c('f',x) - -static char message[128]; - -#define BITS_PER_INT 31 - -static int bits[BITS_PER_INT] = { - 0x00000001,0x00000002,0x00000004,0x00000008, - 0x00000010,0x00000020,0x00000040,0x00000080, - 0x00000100,0x00000200,0x00000400,0x00000800, - 0x00001000,0x00002000,0x00004000,0x00008000, - 0x00010000,0x00020000,0x00040000,0x00080000, - 0x00100000,0x00200000,0x00400000,0x00800000, - 0x01000000,0x02000000,0x04000000,0x08000000, - 0x10000000,0x20000000,0x40000000}; - -static int masks[BITS_PER_INT+1]={ - 0x00000000,0x00000001,0x00000003,0x00000007,0x0000000F, - 0x0000001F,0x0000003F,0x0000007F,0x000000FF, - 0x000001FF,0x000003FF,0x000007FF,0x00000FFF, - 0x00001FFF,0x00003FFF,0x00007FFF,0x0000FFFF, - 0x0001FFFF,0x0003FFFF,0x0007FFFF,0x000FFFFF, - 0x001FFFFF,0x003FFFFF,0x007FFFFF,0x00FFFFFF, - 0x01FFFFFF,0x03FFFFFF,0x07FFFFFF,0x0FFFFFFF, - 0x1FFFFFFF,0x3FFFFFFF,0x7FFFFFFF}; - -#include "io.h" - -#define MK_FLAGS 1 -#define MK_RUNS 2 -#define BUFFERSIZE 128 -#define OFFSET (((ITEM_HDR_SIZE-1)/H_INT_SIZE + 1)*BITS_PER_INT) -/* off_t is used for size and length as well because mixed arithmetic with */ -/* size_t and off_t gives no end of trouble */ -typedef struct { - int item; - int buf[BUFFERSIZE]; - off_t offset,length,size; - int modified,rdonly,tno; - char name[32]; -} MASK_INFO; - - -private void mkfill(MASK_INFO *mask,off_t offset); - -/************************************************************************/ -char *mkopen_c(int tno,char *name,char *status) -/* - This opens a mask item, and readies it for access. - - Inputs: - tno The handle of the data set containing the item. - name Name of the item (something like "mask" or "flags"). - status "old" or "new". - - Output: - mkopen_c This is a handle used in subsequent calls to the maskio - routines. A NULL indicates that an error was encountered. - -------------------------------------------------------------------------*/ -{ - MASK_INFO *mask; - int iostat; - char s[ITEM_HDR_SIZE]; - - mask = (MASK_INFO *)malloc((unsigned int)sizeof(MASK_INFO)); - -/* The case of an old mask file. Perform a number of checks to make sure - the file looks OK. */ - - if(!strcmp("old",status)) { - haccess_c(tno,&(mask->item),name,"read",&iostat); - if(iostat) { free((char *)mask); return(NULL); } - mask->size = hsize_c(mask->item); - if(mask->size <= H_INT_SIZE * (OFFSET/BITS_PER_INT)) - ERROR('f',(message,"Mask file %s appears bad",name)); - hreadb_c(mask->item,s,0,ITEM_HDR_SIZE,&iostat); CHECK(iostat); - if(memcmp(s,int_item,ITEM_HDR_SIZE)) - ERROR('f',(message,"Mask file %s is not integer valued",name)); - mask->rdonly = TRUE; - -/* The case of a new masl file. Create it and make it look nice. */ - - } else if(!strcmp("new",status)) { - haccess_c(tno,&(mask->item),name,"write",&iostat); CHECK(iostat); - hwriteb_c(mask->item,int_item,0,ITEM_HDR_SIZE,&iostat); CHECK(iostat); - mask->size = OFFSET/BITS_PER_INT * H_INT_SIZE; - mask->rdonly = FALSE; - } else ERROR('f',(message,"Unrecognised status %s in MKOPEN",status)); - -/* Common to both old and new mask files. Initialise the structure - describing the file. */ - - mask->size = (mask->size/H_INT_SIZE) * BITS_PER_INT; - mask->offset = -BUFFERSIZE*BITS_PER_INT; - mask->length = 0; - mask->modified = FALSE; - mask->tno = tno; - strcpy(mask->name,name); - - return((char *)mask); -} -/************************************************************************/ -void mkclose_c(char *handle) -/* - This writes out any stuff that we have buffered up, and then closes - the mask file. - - Inputs: - handle Pointer to the structure describing the massk file. -------------------------------------------------------------------------*/ -{ - MASK_INFO *mask; - int iostat; - - mask = (MASK_INFO *)handle; - if(mask->modified) mkflush_c(handle); - hdaccess_c(mask->item,&iostat); CHECK(iostat); - free((char *)mask); -} -/************************************************************************/ -int mkread_c(char *handle,int mode,int *flags,off_t offset,int n,int nsize) -/* -------------------------------------------------------------------------*/ -{ -#define SWITCH_STATE *flags++ = runs + (state ? 0 : 1 ); \ - t = state; state = otherstate; otherstate = t - - MASK_INFO *mask; - off_t i,boff,t,len,blen; - int bitmask,*buf,iostat,state,otherstate,runs; - int *flags0; - - flags0 = flags; - mask = (MASK_INFO *)handle; - offset += OFFSET; - state = 0; - otherstate = 0x7FFFFFFF; - runs = 0; - - -/* Get a buffer full of information if we need it. */ - - while(n > 0){ - if(offset < mask->offset || offset >= mask->offset + mask->length) { - if(mask->modified)mkflush_c(handle); - mask->offset = (offset/BITS_PER_INT)*BITS_PER_INT; - mask->length = min(mask->size - mask->offset,BUFFERSIZE*BITS_PER_INT); - mask->modified = FALSE; - if(mask->length == 0) BUG('f',"Read past end of mask file"); - hreadi_c(mask->item,mask->buf, - (mask->offset/BITS_PER_INT)*H_INT_SIZE, - (mask->length/BITS_PER_INT)*H_INT_SIZE, - &iostat); CHECK(iostat); - } - -/* Copy the flags to the output buffer. Use special sections of code - to deal with all bits being set of clear. */ - - boff = offset - mask->offset; - t = boff/BITS_PER_INT; - buf = mask->buf + t; - len = min(mask->length - boff,n); - boff -= t*BITS_PER_INT; - - n -= len; - offset += len; - -/* Copy to the output, in "flags" format. */ - - if(mode == MK_FLAGS){ - while( len > 0){ - blen = min( BITS_PER_INT - boff,len); - bitmask = *buf++; - if(bitmask == 0x7FFFFFFF) for(i=0; i<blen; i++) *flags++ = FORT_TRUE; - else if(bitmask == 0) for(i=0; i<blen; i++) *flags++ = FORT_FALSE; - else{ - for(i=boff; i<boff+blen; i++) - *flags++ = ( bits[i] & bitmask ? FORT_TRUE : FORT_FALSE ); - } - len -= blen; - boff = 0; - } - -/* Copy to the output, in "runs" format. */ - - } else { - while( len > 0){ - blen = min( BITS_PER_INT - boff,len); - bitmask = *buf++; - if(bitmask == state ) runs += blen; - else if(bitmask == otherstate ) { SWITCH_STATE; runs += blen; } - else { - for(i=boff; i<boff+blen; i++){ - if((bits[i] & bitmask) != (bits[i] & state)) { SWITCH_STATE; } - runs++; - } - } - len -= blen; - boff = 0; - } - } - } - if(state) *flags++ = runs; - nsize -= (flags - flags0); - if(nsize < 0) bug_c('f',"Buffer overflow in MKREAD"); - return(flags - flags0); -} -/************************************************************************/ -void mkwrite_c(char *handle,int mode,Const int *flags,off_t offset, - int n,int nsize) -/* -------------------------------------------------------------------------*/ -{ - MASK_INFO *mask; - off_t i,boff,t,len,blen; - int bitmask,*buf; - int run,curr,state,iostat; - - curr = 0; - state = 1; - run = 0; - - mask = (MASK_INFO *)handle; - offset += OFFSET; - -/* If the mask is currently read-only, close it and reopen it as read/write. */ - - if(mask->rdonly){ - hdaccess_c(mask->item,&iostat); - haccess_c(mask->tno,&(mask->item),mask->name,"append",&iostat); - if(iostat){ - bug_c('w',"Error opening mask/flagging file in read/write mode\n"); - bugno_c('f',iostat); - } - mask->rdonly = FALSE; - } - -/* Check if we have the right buffer. Flush if not. */ - - while(n > 0){ - if(offset < mask->offset || offset >= mask->offset + BUFFERSIZE*BITS_PER_INT) { - if(mask->modified)mkflush_c(handle); - mask->offset = (offset/BITS_PER_INT)*BITS_PER_INT; - mask->length = 0; - mask->modified = FALSE; - } - -/* See if we have to read in any stuff to fill in between the last write - and the current write. */ - - if(offset > mask->offset + mask->length)mkfill(mask,offset); - -/* Copy the flags to the output buffer. */ - - boff = offset - mask->offset; - t = boff/BITS_PER_INT; - buf = mask->buf + t; - len = min(BITS_PER_INT*BUFFERSIZE - boff,n); - boff -= t*BITS_PER_INT; - - mask->length = max(mask->length,offset - mask->offset + len); - mask->modified = TRUE; - - n -= len; - offset += len; - -/* Write to the file, assuming the input is in FLAGS format. */ - - if(mode == MK_FLAGS){ - while( len > 0){ - blen = min( BITS_PER_INT - boff,len); - bitmask = *buf; - for(i=boff; i<boff+blen; i++){ - if(FORT_LOGICAL(*flags)) bitmask |= bits[i]; - else bitmask &= ~bits[i]; - flags++; - } - *buf++ = bitmask; - len -= blen; - boff = 0; - } - -/* Write to the file, assuming the input is in RUNS format. */ - - } else { - while( len > 0 ){ - while(run == 0){ - if(nsize == 0) run = n + len; - else{ - t = *flags++ - (state ? 1 : 0); - run = t - curr; - curr = t; - nsize --; - } - state ^= 1; - } - blen = min(run, min( BITS_PER_INT - boff, len)); - bitmask = masks[boff+blen] ^ masks[boff]; - if(state) *buf |= bitmask; /* Set the bits. */ - else *buf &= ~bitmask; /* Clear the bits. */ - run -= blen; - len -= blen; - boff = (boff + blen) % BITS_PER_INT; - if(!boff) buf++; - } - } - } -} -/************************************************************************/ -void mkflush_c(char *handle) -/* - Flush out the data in the buffer. A complication is that the last - integer in the buffer may not be completely filled. In this case we - have to read in the value of this integer, and copy the old bits to - the output. - - Input: - mask Pointer to the mask structure. -------------------------------------------------------------------------*/ -{ - MASK_INFO *mask; - off_t offset; - int i; - int t,*buf,iostat; - - mask = (MASK_INFO *)handle; - -/* If we are writing at the end of the file, make sure the number we - write is a multiple of BITS_PER_INT. Also update the size of the - file. */ - - if( mask->offset + mask->length >= mask->size) { - mask->length = ((mask->length-1)/BITS_PER_INT + 1)*BITS_PER_INT; - mask->size = mask->offset + mask->length; - -/* If the last word is only partially filled, read in the rest of the - word and transfer the bits. */ - - } else if((mask->length % BITS_PER_INT) != 0) { - offset = (mask->offset + mask->length) / BITS_PER_INT * H_INT_SIZE; - hreadi_c(mask->item,&t,offset,H_INT_SIZE,&iostat); CHECK(iostat); - buf = mask->buf + mask->length/BITS_PER_INT; - i = mask->length % BITS_PER_INT; - *buf = ( t & ~masks[i] ) | (*buf & masks[i]); - mask->length = ((mask->length-1)/BITS_PER_INT + 1)*BITS_PER_INT; - } - -/* Write out the stuff at last. */ - - hwritei_c(mask->item,mask->buf, - mask->offset/BITS_PER_INT*H_INT_SIZE, - mask->length/BITS_PER_INT*H_INT_SIZE,&iostat); CHECK(iostat); - mask->modified = FALSE; -} -/************************************************************************/ -void getmaski_c(Const int mask, int *masks) -/* - Decode an integer into an array of integers representing each bit. - Due to lack of support for masking operations in Fortran-77. - User is responsible for properly allocating enough space in masks[] - The sign bit is not used. - -------------------------------------------------------------------------*/ -{ - int i,n, m; - - n = 8*sizeof(int) - 1; /* skip the sign bit */ - for (i=0, m=1; i<n; i++, m=m<<1){ - // printf("i=%d m=0x%x n=%d\n",i,m,n); - masks[i] = mask & m; - } -} -/************************************************************************/ -void setmaski_c(int *mask, Const int *masks) -/* - Decode an integer into an array of integers representing each bit. - Due to lack of support for masking operations in Fortran-77. - User is responsible for properly allocating enough space in masks[] - The sign bit is not used. - -------------------------------------------------------------------------*/ -{ - int i, n, m, mm; - - n = 8*sizeof(int) - 1; /* skip the sign bit */ - for (i=0, mm=0, m=1; i<n; i++, m=m<<1){ - if (masks[i]) mm |= m; - } - *mask = mm; -} -/************************************************************************/ -private void mkfill(MASK_INFO *mask, off_t offset) -/* - We have to fill in some bits in the current buffer. - - Inputs: - mask Pointer to the mask structure. - offset The first location that we want to write at. -------------------------------------------------------------------------*/ -{ - off_t off,len; - int i,t,*buf,iostat; - - if(mask->offset+mask->length < mask->size) { - buf = mask->buf + mask->length/BITS_PER_INT; - t = *buf; - off = (mask->offset + mask->length)/BITS_PER_INT; - len = min(offset/BITS_PER_INT + 1,mask->size/BITS_PER_INT) - off; - hreadi_c(mask->item,buf, - off*H_INT_SIZE,len*H_INT_SIZE,&iostat); CHECK(iostat); - i = mask->length % BITS_PER_INT; - *buf = ( t & masks[i] ) | (*buf & ~masks[i]); - mask->length = (off + len)*BITS_PER_INT - mask->offset; - } -} Index: casacore-3.5.0/mirlib/maxdimc.h =================================================================== --- casacore-3.5.0.orig/mirlib/maxdimc.h +++ /dev/null @@ -1,32 +0,0 @@ -/* - ------------------------------------------------------------- - maxdimc.h - include file for C code containing MIRIAD-wide - parameters - - MAXDIM .... maximum number of elements in any one plane - (ie, maximum dimensionality of a map) - MAXANT .... maximum number of antennae - MAXBASE ... maximum number of baselines - MAXCHAN ... maximum number of channels in spectral data - - History: - - 04aug91 mjs Original version. - 05aug91 mjs Put parentheses around MAXBASE defined value. - bpw 20jul91 Created as xyzio.h - mjs 08apr92 Minor mod to compile on VAX - rjs 23feb93 Merged maxdimc.h and xyzio.h. Include MAXNAX. - rjs 9sep94 Add MAXWIN - pjt 30apr01 re-aligned maxdimc and maxdim - mhw 07may14 Increase limits to 64 bit values - ------------------------------------------------------------- -*/ - -#define MAXBUF 16777216 -#define MAXDIM 32768 -#define MAXANT 64 -#define MAXBASE ((MAXANT * (MAXANT + 1)) / 2) -#define MAXCHAN 70000 -#define MAXNAX 7 -#define MAXWIN 48 -#define MAXWIDE 18 Index: casacore-3.5.0/mirlib/miriad.h =================================================================== --- casacore-3.5.0.orig/mirlib/miriad.h +++ /dev/null @@ -1,391 +0,0 @@ -/* -// Header that gives C++ code access to the MIRIAD IO routines -// Is now also used a global prototype header file for all C routines -// -// History: -// -// 21-oct-94 pjt Created as follows: -// cproto uvio.c hio.c dio.c bug.c pack.c headio.c maskio.c > miriad.h -// and edited to please the C++ compiler and the eye: -// -// 22-oct-94 pjt added hio.h definitions - clumsy .... pjt -// (the hio routines are macros we don't want to allow that here) -// -// fall-96 pjt minor tidying up for AIPS++ bimafiller release - pjt -// 13-dec-96 rjs Regenerated, using -// cproto -I$MIRINC -p -fARGS hio.c headio.c uvio.c xyio.c xyzio.c bug.c -// 07-feb-97 rjs Added "Const" to definitions, and eliminate some rubbish, as -// suggested by Scott Gordon. -// 19-Mar-97 rjs Check for definition of various thingos before doing them. -// 15-jun-01 pjt Added key.c for BIMA version (ATNF uses keyc.c) as well as -// the uvget* uvrd* macros from uvio.c -// 28-may-02 pjt LFS patches: make it for for > 2GB file using off_t/size_t (prep for MIR4) -// 17-jun-02 pjt added interface.c routines; now used as global prototype file -// 23-jun-02 pjt define MIR4 here if you want to enable the LSF and MIR4 -// 30-aug-04 pjt removed deprecated ARGS() macro -// 1-dec-05 pjt added bugv_c -// 18-may-06 pjt/df added mir.c prototypes for mir (the miriad->mir converter) -// 12-feb-09 dhem added bughandler_c prototype (new function in bug.c) -// 01-apr-09 rjs Add additional interface to scrRecSz -// 7-jan-10 pjt re-aligned ATNF and CARMA code -// 14-dec-11 pkgw Declare errmsg_c() -*/ - -#if !defined(MIR_MIRIAD_H) -#define MIR_MIRIAD_H - - -/* comment this out if you only handle data < 2GB and need to be compatible with old MIRIAD */ -/* or simply define MIR3 through compile options */ -#if !defined(MIR3) -#define MIR4 -#endif - -#include <sys/types.h> /* provides off_t */ -#include <unistd.h> -#include <stdarg.h> -#include "sysdep.h" /* since it now contains the "pack.c" prototypes */ - -/* Define const and void if needed. */ - -#ifndef MIRIAD_TYPES_DEFINED - -#define MIRIAD_TYPES_DEFINED 1 -#ifdef __STDC__ -#if (__STDC__ == 1) -typedef void Void; -#define Const const -#else -typedef char Void; -#define Const /* NULL */ -#endif /* (__STDC__ == 1) */ -#else -typedef char Void; -#define Const /* NULL */ -#endif /* __STDC__ */ - -#if !defined(__cplusplus) -# define private static -#endif /* __cplusplus */ - -/* Define the argument list if needed. */ - -#if !defined(ARGS) -# if defined(__STDC__) || defined(__cplusplus) -# define ARGS(s) s -# else -# define ARGS(s) () -# endif -#endif - -#endif - -#if defined(__cplusplus) -extern "C" { -#endif - -/* hio.h */ - -#if !defined(TRUE) -# define TRUE 1 -#else -# if TRUE != 1 -# error "TRUE should be 1" -# endif -#endif - -#if !defined(FALSE) -# define FALSE 0 -#else -# if FALSE != 0 -# error "FALSE should be 0" -# endif -#endif - -#define H_BYTE 1 -#define H_INT 2 -#define H_INT2 3 -#define H_REAL 4 -#define H_DBLE 5 -#define H_TXT 6 -#define H_CMPLX 7 -#define H_INT8 8 - -/* hio.c */ - -void hopen_c(int *tno, Const char *name, Const char *status, int *iostat); -void hflush_c(int tno, int *iostat); -void habort_c(void); -void hrm_c(int tno); -void hclose_c(int tno); -void hdelete_c(int tno, Const char *keyword, int *iostat); -void haccess_c(int tno, int *ihandle, Const char *keyword, Const char *status, int *iostat); -void hmode_c(int tno, char *mode); -int hexists_c(int tno, Const char *keyword); -void hdaccess_c(int ihandle, int *iostat); -off_t hsize_c(int ihandle); -void hio_c(int ihandle, int dowrite, int type, char *buf, off_t offset, size_t length, int *iostat); -void hseek_c(int ihandle, off_t offset); -off_t htell_c(int ihandle); -void hreada_c(int ihandle, char *line, size_t length, int *iostat); -void hwritea_c(int ihandle, Const char *line, size_t length, int *iostat); - -/* Macros defined in hio.c */ - -#define hreadb_c(item,buf,offset,length,iostat) \ - hio_c(item,FALSE,H_BYTE,buf,offset,length,iostat) -#define hwriteb_c(item,buf,offset,length,iostat) \ - hio_c(item,TRUE,H_BYTE,buf,offset,length,iostat) -#define hreadi_c(item,buf,offset,length,iostat) \ - hio_c(item,FALSE,H_INT,(char *)(buf),offset,length,iostat) -#define hwritei_c(item,buf,offset,length,iostat) \ - hio_c(item,TRUE,H_INT,(char *)(buf),offset,length,iostat) -#define hreadj_c(item,buf,offset,length,iostat) \ - hio_c(item,FALSE,H_INT2,(char *)(buf),offset,length,iostat) -#define hwritej_c(item,buf,offset,length,iostat) \ - hio_c(item,TRUE,H_INT2,(char *)(buf),offset,length,iostat) -#define hreadl_c(item,buf,offset,length,iostat) \ - hio_c(item,FALSE,H_INT8,(char *)(buf),offset,length,iostat) -#define hwritel_c(item,buf,offset,length,iostat) \ - hio_c(item,TRUE,H_INT8,(char *)(buf),offset,length,iostat) -#define hreadr_c(item,buf,offset,length,iostat) \ - hio_c(item,FALSE,H_REAL,(char *)(buf),offset,length,iostat) -#define hwriter_c(item,buf,offset,length,iostat) \ - hio_c(item,TRUE,H_REAL,(char *)(buf),offset,length,iostat) -#define hreadd_c(item,buf,offset,length,iostat) \ - hio_c(item,FALSE,H_DBLE,(char *)(buf),offset,length,iostat) -#define hwrited_c(item,buf,offset,length,iostat) \ - hio_c(item,TRUE,H_DBLE,(char *)(buf),offset,length,iostat) -#define hreadc_c(item,buf,offset,length,iostat) \ - hio_c(item,FALSE,H_CMPLX,(char *)(buf),offset,length,iostat) -#define hwritec_c(item,buf,offset,length,iostat) \ - hio_c(item,TRUE,H_CMPLX,(char *)(buf),offset,length,iostat) -#define hwrite_c(item,type,buf,offset,length,iostat) \ - hio_c(item,TRUE,type,(char *)(buf),offset,length,iostat) -#define hread_c(item,type,buf,offset,length,iostat) \ - hio_c(item,FALSE,type,(char *)(buf),offset,length,iostat) - -/* headio.c */ - -void hisopen_c (int tno, Const char *status); -void hiswrite_c (int tno, Const char *text); -void hisread_c (int tno, char *text, size_t length, int *eof); -void hisclose_c (int tno); -void wrhdr_c (int tno, Const char *keyword, double value); -void wrhdd_c (int tno, Const char *keyword, double value); -void wrhdi_c (int tno, Const char *keyword, int value); -void wrhdl_c (int tno, Const char *keyword, int8 value); -void wrhdc_c (int tno, Const char *keyword, Const float *value); -void wrhda_c (int tno, Const char *keyword, Const char *value); -void rdhdr_c (int tno, Const char *keyword, float *value, double defval); -void rdhdi_c (int tno, Const char *keyword, int *value, int defval); -void rdhdl_c (int tno, Const char *keyword, int8 *value, int8 defval); -void rdhdd_c (int tno, Const char *keyword, double *value, double defval); -void rdhdc_c (int tno, Const char *keyword, float *value, Const float *defval); -void rdhda_c (int tno, Const char *keyword, char *value, Const char *defval, int len); -void hdcopy_c (int tin, int tout, Const char *keyword); -int hdprsnt_c (int tno, Const char *keyword); -void hdprobe_c (int tno, Const char *keyword, char *descr, size_t length, char *type, int *n); - -/* dio.c */ - -void ddelete_c (char *path, int *iostat); -void dtrans_c (char *inpath, char *outpath, int *iostat); -void dmkdir_c (char *path, int *iostat); -void drmdir_c (char *path, int *iostat); -void dopen_c (int *fd, char *name, char *status, off_t *size, int *iostat); -void dclose_c (int fd, int *iostat); -void dread_c (int fd, char *buffer, off_t offset, size_t length, int *iostat); -void dwrite_c (int fd, char *buffer, off_t offset, size_t length, int *iostat); -void dwait_c (int fd, int *iostat); -int dexpand_c (char *tmplte, char *output, int length); -void dopendir_c (char **contxt, char *path); -void dclosedir_c (char *contxt); -void dreaddir_c (char *contxt, char *path, int length); - -/* uvio.c */ - -void uvopen_c (int *tno, Const char *name, Const char *status); -void uvclose_c (int tno); -void uvflush_c (int tno); -void uvnext_c (int tno); -void uvrewind_c (int tno); -int uvdim_c (int tno); -void uvcopyvr_c (int tin, int tout); -int uvupdate_c (int tno); -void uvvarini_c (int tno, int *vhan); -void uvvarset_c (int vhan, Const char *var); -void uvvarcpy_c (int vhan, int tout); -int uvvarupd_c (int vhan); -void uvrdvr_c (int tno, int type, Const char *var, char *data, const char *def, int n); -void uvgetvr_c (int tno, int type, Const char *var, char *data, int n); -void uvprobvr_c (int tno, Const char *var, char *type, int *length, int *updated); -void uvputvr_c (int tno, int type, Const char *var, Const char *data, int n); -void uvtrack_c (int tno, Const char *name, Const char *switches); -int uvscan_c (int tno, Const char *var); -void uvwrite_c (int tno, Const double *preamble, Const float *data, Const int *flags, int n); -void uvwwrite_c (int tno, Const float *data, Const int *flags, int n); -void uvsela_c (int tno, Const char *object, Const char *string, int datasel); -void uvselect_c (int tno, Const char *object, double p1, double p2, int datasel); -void uvset_c (int tno, Const char *object, Const char *type, int n, double p1, double p2, double p3); -void uvread_c (int tno, double *preamble, float *data, int *flags, int n, int *nread); -void uvwread_c (int tno, float *data, int *flags, int n, int *nread); -void uvflgwr_c (int tno, Const int *flags); -void uvwflgwr_c (int tno, Const int *flags); -void uvinfo_c (int tno, Const char *object, double *data); -int uvchkshadow_c (int tno, double diameter_meters); - -/* Macros defined in uvio.c */ - -#define uvputvra_c(tno,name,value) \ - uvputvr_c(tno,H_BYTE,name,value,strlen(value)) -#define uvputvrj_c(tno,name,value,n) \ - uvputvr_c(tno,H_INT2,name,(char *)(value),n) -#define uvputvri_c(tno,name,value,n) \ - uvputvr_c(tno,H_INT,name,(char *)(value),n) -#define uvputvrr_c(tno,name,value,n) \ - uvputvr_c(tno,H_REAL,name,(char *)(value),n) -#define uvputvrd_c(tno,name,value,n) \ - uvputvr_c(tno,H_DBLE,name,(char *)(value),n) -#define uvputvrc_c(tno,name,value,n) \ - uvputvr_c(tno,H_CMPLX,name,(char *)(value),n) - -#define uvgetvra_c(tno,name,value,n) \ - uvgetvr_c(tno,H_BYTE,name,value,n) -#define uvgetvrj_c(tno,name,value,n) \ - uvgetvr_c(tno,H_INT2,name,(char *)(value),n) -#define uvgetvri_c(tno,name,value,n) \ - uvgetvr_c(tno,H_INT,name,(char *)(value),n) -#define uvgetvrr_c(tno,name,value,n) \ - uvgetvr_c(tno,H_REAL,name,(char *)(value),n) -#define uvgetvrd_c(tno,name,value,n) \ - uvgetvr_c(tno,H_DBLE,name,(char *)(value),n) -#define uvgetvrc_c(tno,name,value,n) \ - uvgetvr_c(tno,H_CMPLX,name,(char *)(value),n) - -#define uvrdvra_c(tno,name,data,def,len) \ - uvrdvr_c(tno,H_BYTE,name,data,def,len) -#define uvrdvri_c(tno,name,data,def) \ - uvrdvr_c(tno,H_INT,name,(char *)(data),(char *)(def),1) -#define uvrdvrr_c(tno,name,data,def) \ - uvrdvr_c(tno,H_REAL,name,(char *)(data),(char *)(def),1) -#define uvrdvrd_c(tno,name,data,def) \ - uvrdvr_c(tno,H_DBLE,name,(char *)(data),(char *)(def),1) -#define uvrdvrc_c(tno,name,data,def) \ - uvrdvr_c(tno,H_CMPLX,name,(char *)(data),(char *)(def),1) - -/* xyio.c */ - -void xyopen_c (int *tno, Const char *name, Const char *status, int naxis, int axes[]); -void xyflush_c (int tno); -void xyclose_c (int tno); -int xydim_c (int tno); -void xyread_c (int tno, int index, float *array); -void xywrite_c (int tno, int index, Const float *array); -void xymkrd_c (int tno, int index, int *runs, int n, int *nread); -void xymkwr_c (int tno, int index, Const int *runs, int n); -void xyflgwr_c (int tno, int index, Const int *flags); -void xyflgrd_c (int tno, int index, int *flags); -void xysetpl_c (int tno, int naxis, Const int *axes); - -/* maskio.c */ -char *mkopen_c (int tno, char *name, char *status); -void mkclose_c (char *handle); -int mkread_c (char *handle, int mode, int *flags, off_t offset, int n, int nsize); -void mkwrite_c (char *handle, int mode, Const int *flags, off_t offset, int n, int nsize); -void mkflush_c (char *handle); -void setmaski_c(int *mask, Const int *masks); -void getmaski_c(Const int mask, int *masks); - - -/* xyzio.c */ - -void xyzopen_c (int *tno, Const char *name, Const char *status, int *naxis, int axlen[]); -void xyzclose_c (int tno); -void xyzflush_c (int tno); -void xyzsetup_c (int tno, Const char *subcube, Const int blc[], Const int trc[], int viraxlen[], long vircubesize[]); -void xyzs2c_c (int tno, long subcubenr, int coords[]); -void xyzc2s_c (int tno, Const int coords[], long *subcubenr); -void xyzread_c (int tno, Const int coords[], float *data, int *mask, int *ndata); -void xyzpixrd_c (int tno, long pixelnr, float *data, int *mask); -void xyzprfrd_c (int tno, int profilenr, float *data, int *mask, int *ndata); -void xyzplnrd_c (int tno, int planenr, float *data, int *mask, int *ndata); -void xyzwrite_c (int tno, Const int coords[], Const float *data, Const int *mask, Const int *ndata); -void xyzpixwr_c (int tno, long pixelnr, Const float *data, Const int *mask); -void xyzprfwr_c (int tno, int profilenr, Const float *data, Const int *mask, Const int *ndata); -void xyzplnwr_c (int tno, int planenr, Const float *data, Const int *mask, Const int *ndata); -void xyzmkbuf_c (void); -void xyzdim_c (int tno, int *naxis, int *dimsub); -int xyzpix_c (int tno, int dims); - -/* bug.c */ - -char bugseverity_c(void); -char *bugmessage_c(void); -void bughandler_c(void (*handler)(char s, Const char *m)); -void bugrecover_c(void (*cl)(void)); -void buglabel_c (Const char *name); -void bugno_c (char s, int n); -char *errmsg_c (int n); -void bug_c (char s, Const char *m); -void bugv_c (char s, Const char *m, ...); - -/* scrio.c */ - -void scropen_c (int *handle); -void scrclose_c (int handle); -void scrread_c (int handle, float *buffer, off_t offset, size_t length); -void scrwrite_c (int handle, Const float *buffer, off_t offset, size_t length); -void scrrecsz_c (int handle, size_t recsize); - -/* tabio.c */ - -void tabopen_c (int *tno, Const char *name, Const char *status, int *ncol, int *nrow); -void tabclose_c (int tno); -void tabsetr_c (int tno, int row); -void tabfmtc_c (int tno, int col, char *fmt); -void tabcmt_c (int tno, char *comment); -void tabwcr_c (int tno, int col, float value); -void tabwcd_c (int tno, int col, double value); -void tabwci_c (int tno, int col, int value); -void tabwca_c (int tno, int col, char *value); -void tabgetr_c (int tno, int row, float *data); -void tabgetd_c (int tno, int row, double *data); -void tabgeta_c (int tno, int row, char *data); - - -/* key.c */ - -void keyinit_c (Const char *task); -void keyput_c (Const char *task, char *string); -void keyini_c (int argc, char *argv[]); -void keyfin_c (void); -int keyprsnt_c (Const char *keyword); -void keya_c (Const char *keyword, char *value, Const char *keydef); -void keyf_c (Const char *keyword, char *value, Const char *keydef); -void keyd_c (Const char *keyword, double *value, Const double keydef); -void keyr_c (Const char *keyword, float *value, Const float keydef); -void keyi_c (Const char *keyword, int *value, Const int keydef); -void keyl_c (Const char *keyword, int *value, Const int keydef); -void mkeyd_c (Const char *keyword, double value[], Const int nmax, int *n); -void mkeyr_c (Const char *keyword, float value[], Const int nmax, int *n); -void mkeyi_c (Const char *keyword, int value[], Const int nmax, int *n); - -/* mir.c */ -void mirInit_c(const char *f_name); -void mirClose_c(void); -void inWrite_c(const int conid, const int icocd, const int traid, const int inhid, const int ints, const int itq, const float az, const float el, const float ha, const int iut, const int iref_time, const double dhrs, const float vc, const int ivctype, const double sx, const double sy, const double sz, const float rinteg, const int proid, const int souid, const int isource, const int ipos, const float offx, const float offy, const int iofftype, const int ira, const int idec, const double rar, const double decr, const float epoch, const float sflux, const float size); -void blWrite_c(const int blhid, const int inhid, const int isb, const int ipol, const float pa, const int iaq, const int ibq, const int icq, const int ioq, const int irec, const int iffc, const float u, const float v, const float w, const float prbl, const float angres, const float vis, const float coh, const float sigcoh, const float csnr, const float vflux, const float cnoise, const double avedhrs, const float ampav, const float phaave, const float tpvar, const int blsid, const int itel1, const int itel2, const int iblcd, const float ble, const float bln, const float blu, const int soid); -void spWrite_c(const int sphid, const int blhid, const int inhid, const int igq, const int ipq, const int iband, const int ipstate, const float tau0, const double vel, const float vres, const int ivtype, const double fsky, const float fres, const float tssb, const float integ, const float wt, const int itaper, const float snoise, const int nch, const int nrec, const int dataoff, const int linid, const int itrans, const double rfreq, const int pasid, const int gaiidamp, const int gaiidpha, const int flcid, const int atmid); -void codeWrite_c(const char *v_name, const int icode, const char *code, const int ncode); -void visWrite_c(const float *re, const float *im, const int numvis, const int startvis, int *nbytes); - -/* interface.c */ -void pad(char *string, int length); -char *zterm(char *string, int length); - -#if defined(__cplusplus) -} -#endif - -#endif /* MIR_MIRIAD_H */ Index: casacore-3.5.0/mirlib/pack.c =================================================================== --- casacore-3.5.0.orig/mirlib/pack.c +++ /dev/null @@ -1,643 +0,0 @@ -/* pack */ -/* & pjt */ -/* : low-level-i/o */ -/* + */ -/* */ -/* This converts data between disk and internal */ -/* format. Disk format is IEEE reals and 16 or 32 */ -/* bit integers (most significant byte first). */ -/* */ -/* This assumes that these are the local machine format */ -/* (float == IEEE real, int == 32 bit integer, */ -/* short int == 16 bit integer). */ -/* */ -/* packx_c, unpackx_c, pack32_c and unpack32_c are */ -/* implemented as macros (calling bcopy) in the */ -/* system dependent include file. */ -/*-- */ -/* */ -/* History: */ -/* rjs Dark-ages Original version. */ -/* bs ?????89 Improved efficiency using "register" declarations. */ -/* rjs 1nov89 Incoporated Brian's changes. */ -/* mjs 28feb91 Merge Sun and Cray versions. */ -/* mjs 18mar91 Added convex definition. */ -/* mjs 19feb93 Added mips definition. */ -/* pjt 25jan95 linux kludge to include packALPHA.c */ -/* pjt 14jun01 packALPHA.c now included in this source code */ -/* and using the standard WORDS_BIGENDIAN macro */ -/* pjt 21jun02 MIR4 prototyping */ -/************************************************************************/ - -#if defined(HAVE_CONFIG_H) && HAVE_CONFIG_H -#include "config.h" -#endif - -#include "sysdep.h" -#include "miriad.h" - -#if defined(WORDS_BIGENDIAN) - -static int words_bigendian = 1; /* never used actually, but handy symbol to find via nm(1) */ - -void pack16_c(register int *from,char *to,int n) -{ - register short int *tto; - register int i; - - tto = (short int *)to; - for (i=0; i < n; i++) *tto++ = *from++; -} -void unpack16_c(char *from,register int *to,int n) -{ - register short int *ffrom; - register int i; - - ffrom = (short int *)from; - for (i=0; i < n; i++) *to++ = *ffrom++; -} - -void pack64_c(register int *from,char *to,int n) -{ - register short int *tto; - register int i; - - tto = (short int *)to; - for (i=0; i < n; i++) *tto++ = *from++; -} -void unpack64_c(char *from,register int *to,int n) -{ - register short int *ffrom; - register int i; - - ffrom = (short int *)from; - for (i=0; i < n; i++) *to++ = *ffrom++; -} - -#endif - - -#ifndef WORDS_BIGENDIAN -#ifndef unicos -static int words_littleendian = 1; /* never used actually, but handy symbol to find via nm(1) */ -/************************************************************************/ -/* */ -/* The pack routines -- these convert between the host format and */ -/* the disk format. Disk format is IEEE 32 and 64 bit reals, and 2's */ -/* complement integers. Byte order is the FITS byte order (most */ -/* significant bytes first). */ -/* */ -/* This version is for a machine which uses IEEE internally, but which */ -/* uses least significant bytes first (little endian), e.g. PCs and */ -/* Alphas. */ -/* */ -/* History: */ -/* rjs 21nov94 Original version. */ -/************************************************************************/ -void pack16_c(int *in,char *out,int n) -/* - Pack an integer array into 16 bit integers. -------------------------------------------------------------------------*/ -{ - int i; - char *s; - - s = (char *)in; - for(i=0; i < n; i++){ - *out++ = *(s+1); - *out++ = *s; - s += sizeof(int); - } -} -/************************************************************************/ -void unpack16_c(char *in,int *out,int n) -/* - Unpack an array of 16 bit integers into integers. -------------------------------------------------------------------------*/ -{ - int i; - char *s; - - s = (char *)out; - for(i=0; i < n; i++){ - *s++ = *(in+1); - *s++ = *in; - if(0x80 & *in){ - *s++ = 0xFF; - *s++ = 0xFF; - } else { - *s++ = 0; - *s++ = 0; - } - in += 2; - } -} -/************************************************************************/ -void pack32_c(int *in,char *out,int n) -/* - Pack an array of integers into 32 bit integers. -------------------------------------------------------------------------*/ -{ - int i; - char *s; - - s = (char *)in; - for(i = 0; i < n; i++){ - *out++ = *(s+3); - *out++ = *(s+2); - *out++ = *(s+1); - *out++ = *s; - s += 4; - } -} -/************************************************************************/ -void unpack32_c(char *in,int *out,int n) -/* - Unpack an array of 32 bit integers into integers. -------------------------------------------------------------------------*/ -{ - int i; - char *s; - - s = (char *)out; - for(i = 0; i < n; i++){ - *s++ = *(in+3); - *s++ = *(in+2); - *s++ = *(in+1); - *s++ = *in; - in += 4; - } -} -/************************************************************************/ -void pack64_c(int8 *in,char *out,int n) -/* - Pack an integer array into 64 bit integers. -------------------------------------------------------------------------*/ -{ - int i; - char *s; - - s = (char *)in; - for(i=0; i < n; i++){ - *out++ = *(s+7); - *out++ = *(s+6); - *out++ = *(s+5); - *out++ = *(s+4); - *out++ = *(s+3); - *out++ = *(s+2); - *out++ = *(s+1); - *out++ = *s; - s += 8; - } -} -/************************************************************************/ -void unpack64_c(char *in,int8 *out,int n) -/* - Unpack an array of 64 bit integers into integers. -------------------------------------------------------------------------*/ -{ - int i; - char *s; - - s = (char *)out; - for(i=0; i < n; i++){ - *s++ = *(in+7); - *s++ = *(in+6); - *s++ = *(in+5); - *s++ = *(in+4); - *s++ = *(in+3); - *s++ = *(in+2); - *s++ = *(in+1); - *s++ = *in; - in += 8; - } -} -/************************************************************************/ -void packr_c(float *in,char *out,int n) -/* - Pack an array of reals into IEEE reals -- just do byte reversal. -------------------------------------------------------------------------*/ -{ - int i; - char *s; - - s = (char *)in; - for(i = 0; i < n; i++){ - *out++ = *(s+3); - *out++ = *(s+2); - *out++ = *(s+1); - *out++ = *s; - s += 4; - } -} -/************************************************************************/ -void unpackr_c(char *in,float *out,int n) -/* - Unpack an array of IEEE reals into reals -- just do byte reversal. -------------------------------------------------------------------------*/ -{ - int i; - char *s; - - s = (char *)out; - for(i = 0; i < n; i++){ - *s++ = *(in+3); - *s++ = *(in+2); - *s++ = *(in+1); - *s++ = *in; - in += 4; - } -} -/************************************************************************/ -void packd_c(double *in,char *out,int n) -/* - Pack an array of doubles -- this involves simply performing byte - reversal. -------------------------------------------------------------------------*/ -{ - int i; - char *s; - - s = (char *)in; - for(i = 0; i < n; i++){ - *out++ = *(s+7); - *out++ = *(s+6); - *out++ = *(s+5); - *out++ = *(s+4); - *out++ = *(s+3); - *out++ = *(s+2); - *out++ = *(s+1); - *out++ = *s; - s += 8; - } -} -/************************************************************************/ -void unpackd_c(char *in,double *out,int n) -/* - Unpack an array of doubles -- this involves simply performing byte - reversal. -------------------------------------------------------------------------*/ -{ - int i; - char *s; - - s = (char *)out; - for(i = 0; i < n; i++){ - *s++ = *(in+7); - *s++ = *(in+6); - *s++ = *(in+5); - *s++ = *(in+4); - *s++ = *(in+3); - *s++ = *(in+2); - *s++ = *(in+1); - *s++ = *in; - in += 8; - } -} -#endif -#endif - - -#if defined(unicos) -static int words_unicos = 1; -#define TWO15 0x8000 -#define TWO16 0x10000 -#define TWO31 0x80000000 -#define TWO32 0x100000000 -#define HILONG 0xFFFFFFFF00000000 -#define LOLONG 0x00000000FFFFFFFF -#define WORD0 0x000000000000FFFF -#define WORD1 0x00000000FFFF0000 -#define WORD2 0x0000FFFF00000000 -#define WORD3 0xFFFF000000000000 - -/* Masks for IEEE floating format (both hi and lo types). */ - -#define IEEE_HISIGN 0x8000000000000000 -#define IEEE_HIEXPO 0x7F80000000000000 -#define IEEE_HIMANT 0x007FFFFF00000000 -#define IEEE_LOSIGN 0x0000000080000000 -#define IEEE_LOEXPO 0x000000007F800000 -#define IEEE_LOMANT 0x00000000007FFFFF -#define IEEE_DMANT 0x000FFFFFFFFFFFF0 -#define IEEE_DEXPO 0x7FF0000000000000 - -/* Masks for Cray floating format. */ - -#define CRAY_MANT 0x0000FFFFFF000000 /* Including unhidden bit. */ -#define CRAY_MANT1 0x00007FFFFF000000 /* No unhidden bit. */ -#define CRAY_DMANT 0x0000FFFFFFFFFFFF -#define CRAY_DMANT1 0x00007FFFFFFFFFFF -#define CRAY_EXPO 0x7FFF000000000000 -#define SIGN 0x8000000000000000 - -/* Mask of a pointer to char giving the character offset in a Cray word. */ - -#define CHAR_OFFSET 0xE000000000000000 - -/************************************************************************/ -void pack16_c(int *in,char *out,int n) -/* - Pack an integer array into 16 bit integers for unicos -------------------------------------------------------------------------*/ -{ - int temp,offset,*outd,in1,in2,in3,in4,i; - - if(n <= 0)return; /* Return if nothing to do. */ - temp = (int)out; - offset = ( temp & CHAR_OFFSET ) >> 62; /* Get offset of first word. */ - outd = (int *)(temp & ~CHAR_OFFSET); /* Get address of words. */ - -/* Handle the first few which are not aligned on a Cray word. */ - - switch(offset){ - case 1: *outd = (*outd & ~WORD2) | ((*in++ << 32) & WORD2); - if(--n == 0)break; - case 2: *outd = (*outd & ~WORD1) | ((*in++ << 16) & WORD1); - if(--n == 0)break; - case 3: *outd = (*outd & ~WORD0) | ((*in++ ) & WORD0); - outd++; - } - -/* Handle the ones which are aligned on a Cray word. */ - - for(i=0; i < n-3; i=i+4){ - in1 = *in++ << 48; - in2 = *in++ << 32; - in3 = *in++ << 16; - in4 = *in++; - *outd++ = (in1 & WORD3) | (in2 & WORD2) | (in3 & WORD1) | (in4 & WORD0); - } - n -= i; - -/* Handle the last ones which are not aligned on a Cray word. */ - - if(n-- > 0){ - *outd = (*outd & ~WORD3) | ((*in++ << 48) & WORD3); - if(n-- > 0){ - *outd = (*outd & ~WORD2) | ((*in++ << 32) & WORD2); - if(n-- > 0){ - *outd = (*outd & ~WORD1) | ((*in++ << 16) & WORD1); - } - } - } -} -/************************************************************************/ -void unpack16_c(char *in,int *out,int n) -/* - Unpack an array of 16 bit integers into integers for unicos -------------------------------------------------------------------------*/ -{ - int temp,offset,*ind,i; - - if(n <= 0)return; /* Return if nothing to do. */ - temp = (int)in; - offset = ( temp & CHAR_OFFSET ) >> 62; /* Get offset of first word. */ - ind = (int *)(temp & ~CHAR_OFFSET); /* Get address of words. */ - -/* Handle the first few which are not word aligned. */ - - switch(offset){ - case 1: temp = (*ind >> 32) & WORD0; - *out++ = (temp < TWO15 ? temp : temp - TWO16); - if(--n == 0) break; - case 2: temp = (*ind >> 16) & WORD0; - *out++ = (temp < TWO15 ? temp : temp - TWO16); - if(--n == 0) break; - case 3: temp = (*ind++ ) & WORD0; - *out++ = (temp < TWO15 ? temp : temp - TWO16); - if(--n == 0) break; - } - -/* Handle those that are Cray-word-aligned. */ - - for(i=0; i < n-3; i=i+4){ - temp = (*ind >> 48) & WORD0; - *out++ = (temp < TWO15 ? temp : temp - TWO16); - temp = (*ind >> 32) & WORD0; - *out++ = (temp < TWO15 ? temp : temp - TWO16); - temp = (*ind >> 16) & WORD0; - *out++ = (temp < TWO15 ? temp : temp - TWO16); - temp = (*ind++ ) & WORD0; - *out++ = (temp < TWO15 ? temp : temp - TWO16); - } - n -= i; - -/* Handle the last few which are not Cray-word-aligned. */ - - if(n-- > 0){ - temp = (*ind >> 48) & WORD0; - *out++ = (temp < TWO15 ? temp : temp - TWO16); - if(n-- > 0){ - temp = (*ind >> 32) & WORD0; - *out++ = (temp < TWO15 ? temp : temp - TWO16); - if(n-- > 0){ - temp = (*ind >> 16) & WORD0; - *out++ = (temp < TWO15 ? temp : temp - TWO16); - } - } - } -} -/************************************************************************/ -void pack32_c(int *in,char *out,int n) -/* - Pack an array of integers into 32 bit integers for unicos -------------------------------------------------------------------------*/ -{ - int temp,offset,*outd,i,in1,in2; - - if(n <= 0)return; /* Return if nothing to do. */ - temp = (int)out; - offset = ( temp & CHAR_OFFSET ) >> 63; /* Get offset of first long. */ - outd = (int *)(temp & ~CHAR_OFFSET); /* Get address of words. */ - -/* Do the first one, if it is not aligned on a Cray word. */ - - if(offset==1){ - *outd = (*outd & ~LOLONG) | (*in++ & LOLONG); - outd++; - } - n -= offset; - -/* Do those which are Cray word aligned. */ - - for(i=0; i < n-1; i=i+2){ - in1 = *in++ << 32; - in2 = *in++; - *outd++ = (in1 & HILONG) | (in2 & LOLONG); - } - n -= i; - -/* Handle the last one, if there is one. */ - - if(n==1)*outd = (*outd & ~HILONG) | ((*in++ << 32) & HILONG); -} -/************************************************************************/ -void unpack32_c(char *in,int *out,int n) -/* - Unpack an array of 32 bit integers into integers for unicos -------------------------------------------------------------------------*/ -{ - int temp,offset,*ind,i; - - if(n <= 0)return; /* Return if nothing to do. */ - temp = (int)in; - offset = ( temp & CHAR_OFFSET ) >> 63; /* Get offset of first word. */ - ind = (int *)(temp & ~CHAR_OFFSET); /* Get address of words. */ - -/* Handle one which is not Cray word aligned. */ - - if(offset==1){ - temp = (*ind++ & LOLONG); - *out++ = (temp < TWO31 ? temp : temp - TWO32); - } - n -= offset; - -/* Handle those which are Cray word aligned. */ - - for(i=0; i < n-1; i=i+2){ - temp = (*ind >> 32) & LOLONG; - *out++ = (temp < TWO31 ? temp : temp - TWO32); - temp = (*ind++ ) & LOLONG; - *out++ = (temp < TWO31 ? temp : temp - TWO32); - } - n -= i; - -/* Possibly handle a last one which is not Cray word aligned. */ - - if(n==1){ - temp = (*ind >> 32) & LOLONG; - *out++ = (temp < TWO31 ? temp : temp - TWO32); - } -} -/************************************************************************/ -void packr_c(float *in,char *out,int n) -/* - Pack an array of Cray reals into IEEE reals. -------------------------------------------------------------------------*/ -{ - int temp,offset,*outd,bias,*ind,tin,tout,i; - - if(n <= 0)return; /* Return if nothing to do. */ - temp = (int)out; - offset = ( temp & CHAR_OFFSET ) >> 63; /* Get offset of first long. */ - outd = (int *)(temp & ~CHAR_OFFSET); /* Get address of words. */ - bias = (16384 - 126) << 48; - ind = (int *)in; - -/* Do the first one, if it is not aligned on a Cray word. */ - - if(offset==1){ - tin = *ind++; - *outd = (*outd & ~LOLONG) | - (tin & CRAY_MANT ? (((tin & CRAY_EXPO)-bias) >> 25) | - ((tin & CRAY_MANT1) >> 24) | ((tin & SIGN) >> 32) : 0); - outd++; - } - n -= offset; - -/* Do those which are Cray word aligned. */ - - for(i=0; i < n-1; i=i+2){ - tin = *ind++; - tout = (tin & CRAY_MANT ? (((tin & CRAY_EXPO)-bias) << 7) | - ((tin & CRAY_MANT1) << 8) | (tin & SIGN) : 0); - tin = *ind++; - *outd++ = tout | - (tin & CRAY_MANT ? (((tin & CRAY_EXPO)-bias) >> 25) | - ((tin & CRAY_MANT1) >> 24) | ((tin & SIGN) >> 32) : 0); - } - n -= i; - -/* Handle the last one, if there is one. */ - - if(n==1){ - tin = *ind; - *outd = (*outd & ~HILONG) | - (tin & CRAY_MANT ? (((tin & CRAY_EXPO)-bias) << 7) | - ((tin & CRAY_MANT1) << 8) | (tin & SIGN) : 0); - } -} -/************************************************************************/ -void unpackr_c(char *in,float *out,int n) -/* - Unpack an array of IEEE reals into Cray reals. -------------------------------------------------------------------------*/ -{ - int temp,tin,*ind,*outd,offset,i,bias; - - if(n <= 0)return; /* Return if nothing to do. */ - temp = (int)in; - offset = ( temp & CHAR_OFFSET ) >> 63; /* Get offset of first word. */ - ind = (int *)(temp & ~CHAR_OFFSET); /* Get address of words. */ - outd = (int *)out; - bias = ((16384-126) <<48) + (1 << 47); - -/* Handle the first one if it is not aligned on a Cray word. */ - - if(offset==1){ - tin = *ind++; - *outd++ = (tin & IEEE_LOEXPO ? (((tin & IEEE_LOEXPO) << 25)+bias) | - ((tin & IEEE_LOMANT) << 24) | ((tin & IEEE_LOSIGN) << 32) : 0); - } - n -= offset; - -/* Handle the bulk of them that are aligned on Cray words. */ - - for(i=0; i < n-1; i=i+2){ - tin = *ind++; - *outd++ = (tin & IEEE_HIEXPO ? (((tin & IEEE_HIEXPO) >> 7)+bias) | - ((tin & IEEE_HIMANT) >> 8 ) | (tin & IEEE_HISIGN) : 0); - *outd++ = (tin & IEEE_LOEXPO ? (((tin & IEEE_LOEXPO) << 25)+bias) | - ((tin & IEEE_LOMANT) << 24) | ((tin & IEEE_LOSIGN) << 32) : 0); - } - n -= i; - -/* Handle the last one, if needed, which is not aligned on a Cray word. */ - - if(n==1){ - tin = *ind; - *outd++ = (tin & IEEE_HIEXPO ? (((tin & IEEE_HIEXPO) >> 7)+bias) | - ((tin & IEEE_HIMANT) >> 8 ) | (tin & IEEE_HISIGN) : 0); - } -} -/************************************************************************/ -void packd_c(double *in,char *out,int n) -/* - Pack an array of Cray reals into IEEE double precision. This assumes - that a "double" and a "float" are identical. -------------------------------------------------------------------------*/ -{ - int *ind,*outd,bias,i,tin; - - ind = (int *)in; - outd = (int *)out; - bias = (16384 - 1022) << 48; - - for(i=0; i < n; i++){ - tin = *ind++; - *outd++ = (tin & CRAY_DMANT ? (tin & SIGN) | - (((tin & CRAY_EXPO)-bias) << 4) | ((tin & CRAY_DMANT1) << 5) : 0 ); - } -} -/************************************************************************/ -void unpackd_c(char *in,double *out,int n) -/* - Unpack an array of IEEE double precision numbers into Cray reals. This - assumes that a "double" and a "float" are identical. -------------------------------------------------------------------------*/ -{ - int *ind,*outd,bias,i,tin; - - ind = (int *)in; - outd = (int *)out; - bias = ((16384 - 1022) << 48) | (1 << 47); - - for(i=0; i < n; i++){ - tin = *ind++; - *outd++ = (tin & IEEE_DEXPO ? (tin & SIGN) | - (((tin & IEEE_DEXPO) >> 4) + bias) | ((tin & IEEE_DMANT) >> 5) : 0 ); - } -} - -#endif Index: casacore-3.5.0/mirlib/scrio.c =================================================================== --- casacore-3.5.0.orig/mirlib/scrio.c +++ /dev/null @@ -1,201 +0,0 @@ -/************************************************************************/ -/* */ -/* A collection of routines to manipulate scratch files. */ -/* */ -/* History: */ -/* rjs Dark-ages Original version. */ -/* rjs 6nov94 Change item handle to an integer. */ -/* rjs 26oct95 Better messages on errors. */ -/* pjt 19jun02 MIR4 prototypes */ -/* jwr 05nov04 Change file offsets to type off_t */ -/* rjs 03jan05 Include file rationalisation. */ -/* pjt 16feb07 Minor doc improvements */ -/* pjt 11dec07 More helpful message when scratch files fail */ -/* rjs 01apr09 Add scrRecSz routine and associated work. */ -/* rjs 13may09 Make returned handle always positive (some tasks have*/ -/* relied on this). */ -/* pjt 7jan09 Merged in previous CARMA changes, long live CVS */ -/************************************************************************/ - -#if defined(HAVE_CONFIG_H) && HAVE_CONFIG_H -#include "config.h" -#endif - -#include <stdio.h> -#include "miriad.h" -#include "io.h" - - -#define MAXITEMS 100 -static int number=0; -static int items[MAXITEMS],first; -size_t recsiz[MAXITEMS]; - -/************************************************************************/ -void scropen_c(int *handle) -/**scropen -- Open a scratch file. */ -/*:scratch-i/o */ -/*+ FORTRAN call sequence: - - subroutine scropen(tno) - integer tno - - This opens a scratch file, and readies it for use. - Scratch files will be removed when they are closed, multiple scratch - files are allowed, and they always live in the current directory, unless - the $TMPDIR environment variable points to another directory. - - Output: - tno The handle of the scratch file. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int iostat,temp,i; - char name[32]; - -/* Initialise the first time through. */ - - if(number == 0){ - for(i=0;i<MAXITEMS-1;i++){ - items[i] = i+1; - } - items[MAXITEMS-1] = -1; - first = 0; - } - -/* Get a handle. */ - - if(first < 0)bug_c('w',"Exhausted the number of open scratch files"); - *handle = first+1; - first = items[first]; - -/* Open the scratch file. */ - - (void)sprintf(name,"scratch%d",number++); - haccess_c(0,&temp,name,"scratch",&iostat); - if(iostat){ - bug_c( 'w',"Error opening scratch file; check your $TMPDIR"); - bugno_c('f',iostat); - } - items[*handle-1] = temp; - recsiz[*handle-1] = sizeof(float); -} -/************************************************************************/ -void scrclose_c(int handle) -/**scrclose -- Close and delete a scratch file. */ -/*:scratch-i/o */ -/*+ FORTRAN call sequence: - - subroutine scrclose(tno) - integer tno - - This closes and deletes a scratch file. The scratch file cannot be - accessed again, after it is closed. - Input: - tno The handle of the scratch file. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int iostat; - handle--; - hdaccess_c(items[handle],&iostat); - items[handle] = first; - first = handle; - if(iostat){ - bug_c( 'w',"Error closing scratch file; check your $TMPDIR"); - bugno_c('f',iostat); - } -} -/************************************************************************/ -void scrrecsz_c(int handle,size_t recsize) -/**scrrecsz -- Set record size to be used. */ -/*:scratch-i/o */ -/*+ FORTRAN call sequence: - - subroutine scrrecsz(tno,recsize) - integer tno,recsize - - This sets the record size to be used in future access operations. - Input: - tno The handle of the scratch file. - recsize The record size (measured in reals). */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - handle--; - if(recsize <= 0)bug_c('f',"Invalid record size, in scrrecsz"); - recsiz[handle] = recsize*sizeof(float); -} -/************************************************************************/ -void scrread_c(int handle,float *buffer,off_t offset,size_t length) -/**scrread -- Read real data from a scratch file. */ -/*:scratch-i/o */ -/*+ FORTRAN call sequence: - - subroutine scrread(tno,buf,offset,length) - integer tno,offset,length - real buf(length) - - This reads real data from the scratch file. - Input: - tno The handle of the scratch file. - offset The offset (measured in reals) into the scratch file - to read. The first real has offset 0. - length The number of reals to read. - Output: - buf The returned data. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int iostat; - int myhandle; - off_t myoff; - size_t mylen; - - handle--; - myhandle = items[handle]; - mylen = recsiz[handle]*length; - myoff = recsiz[handle]*offset; - - hreadb_c(myhandle,(char *)buffer,myoff,mylen,&iostat); - if(iostat){ - bug_c( 'w',"Error reading from scratch file; check your $TMPDIR"); - bugno_c('f',iostat); - } -} -/************************************************************************/ -void scrwrite_c(int handle,Const float *buffer,off_t offset,size_t length) -/**scrwrite -- Write real data to the scratch file. */ -/*:scratch-i/o */ -/*+ FORTRAN call sequence: - - subroutine scrwrite(tno,buf,offset,length) - integer tno,offset,length - real buf(length) - - This writes real data to the scratch file. - Input: - tno The handle of the scratch file. - offset The offset (measured in reals) into the scratch file - to write. The first real has offset 0. - length The number of reals to write. - buf The data to write. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int iostat; - int myhandle; - off_t myoff; - size_t mylen; - - handle--; - myhandle = items[handle]; - mylen = recsiz[handle]*length; - myoff = recsiz[handle]*offset; - - hwriteb_c(myhandle,(char *)buffer,myoff,mylen,&iostat); - if(iostat){ - bug_c( 'w',"Error writing to scratch file; check your $TMPDIR"); - bugno_c('f',iostat); - } -} Index: casacore-3.5.0/mirlib/sysdep.h =================================================================== --- casacore-3.5.0.orig/mirlib/sysdep.h +++ /dev/null @@ -1,184 +0,0 @@ -/* - * History: - * pjt 31oct89 _trace_ added as defined() option, BUFALIGN 8. - * rjs 21feb90 Added alternate way of defining FORT_TRUE and FALSE - * to improve XMP and Cray-2 compatibility. This change - * care of Brian Glendenning. - * mjs ?? Increased BUFSIZE to avoid apparent OS problem on "ral". - * rjs 8feb91 Convex definitions. - * mjs 18mar91 More Convex definitions. - * rjs 16apr91 Removed macros redefining memcpy as bcopy -- no longer - * needed, and bcopy is slower on the Suns anyway. - * rjs 24jun91 Added memcmp define for the convex. - * rjs 18dec92 Added hpux. Various tidying. - * mjs 19feb93 Added mips. - * jm 07nov94 Added definition of Null and typedef of Void. The - * Void typedef permits proper casting in both ANSI - * and non-ANSI archs. Also added definition to permit - * the use of const in non-ANSI declarations. - * jm 17nov94 Changed the conditional definition around the typedef - * of Void because Sun defines __STDC__ even when it is - * zero! Defined PROTOTYPE as 1 if __STDC__ is set to 1; - * otherwise it is undefined. Also added ARGS definition - * to aide forward declartion prototyping. - * rjs 20nov94 Added "alpha" ifdef. - * rjs 19mar97 Add FORTRAN_LOGICAL define and check that miriad.h declarations - * have not been done before doing them again. - * pjt 14jun01 use WORDS_BIGENDIAN to figure out the pack routines - * removed 'trace' clutter from the old multiflow - * pjt 24jun01 PPC/powerpc is a BIGENDIAN (linux) machine - * pjt 21jun02 MIR4 - * pjt 4jan05 merged in the new ATNF HAS_STRERROR - * pjt 6feb07 kludge for darwin_intel - * cgk 20dec07 make HAS_STRERROR be HAVE_STRERROR per configure.ac - */ - -#if !defined(MIR_SYSDEP_H) -#define MIR_SYSDEP_H - -#include <sys/types.h> -#include <unistd.h> - - -#ifndef Null -#define Null '\0' -#endif - -/* - * Void is typedef'd to the proper word depending on the level of - * ANSI conformance. Also, if ANSI conforming, Const is defined - * to const; otherwise, Const is defined as a NULL statement. - * - * PROTOTYPE is defined only if function prototypes are correctly - * understood. - * - * ARGS defines a macro that aides in presenting prototypes. - * Use it as (double parentheses required): - * extern void keyput_c ARGS((const char *task, char *arg)); - */ - -#ifndef MIRIAD_TYPES_DEFINED -#define MIRIAD_TYPES_DEFINED 1 -#ifdef __STDC__ -#if (__STDC__ == 1) -typedef void Void; -#define Const const -#define PROTOTYPE 1 -#define ARGS(s) s -#else -typedef char Void; -#define Const /* NULL */ -#define ARGS(s) () -#endif /* (__STDC__ == 1) */ -#else -typedef char Void; -#define Const /* NULL */ -#define ARGS(s) () -#endif /* __STDC__ */ -#if !defined(__cplusplus) -#define private static -#endif /* __cplusplus */ -#endif /* MIRIAD_TYPES_DEFINED */ - -typedef int int2; -typedef long long int int8; - -/************************************************************************/ -/* */ -/* UNICOS definitions */ -/* */ -/************************************************************************/ - -#ifdef unicos -#include <fortran.h> -#define FORT_TRUE _btol(1) -#define FORT_FALSE _btol(0) -#define FORT_LOGICAL(a) (_ltob((&(a)))) -#define BUFDBUFF 0 -#define BUFALIGN 8 -#define BUFSIZE 16384 -#define defined_params -#endif - -/************************************************************************/ -/* */ -/* UNIX definitions. */ -/* */ -/************************************************************************/ - -#ifndef defined_params -#if defined(convex) || defined(alpha) || defined(__alpha) -# define FORT_TRUE -1 -#else -# define FORT_TRUE 1 -#endif - -#define FORT_FALSE 0 -#define FORT_LOGICAL(a) ((a) != FORT_FALSE) - -#define BUFDBUFF 0 -#define BUFALIGN 2 -#define BUFSIZE 16384 - -/* Some machines have the "strerror" routine. Linux whinges significantly - if you use the "old" way of doing effectively what strerror does. */ - -/* strerror is POSIX and should be supported under any POSIX.1 system */ -/* Moving check for strerror into configure steps to define HAVE_STRERROR */ -/* left old style build compatible check in bug.c */ - - -/* Short cut routines when no conversion is necessary. These are - used for any IEEE floating point machine with FITS ordered bytes. - - WORDS_BIGENDIAN is also defined though the 'autoconf' package - and should appear in config.h if it's used (sun's, linuxppc, etc.) - two routines, pack16_c() and unpack16_c() are actually defined - in pack.c - - */ - - -#ifndef WORDS_BIGENDIAN -# if defined (sun) || defined (convex) || defined (mips) || defined(sgi) || defined(hpux) -# define WORDS_BIGENDIAN -# endif -# if defined(PPC) || defined(powerpc) || defined(darwin_ppc) -# define WORDS_BIGENDIAN -# endif -#endif - -#if defined(i386) -#undef WORDS_BIGENDIAN -#endif - -#ifdef WORDS_BIGENDIAN -# define packr_c(a,b,c) memcpy((b),(char *)(a),sizeof(float)*(c)) -# define unpackr_c(a,b,c) memcpy((char *)(b),(a),sizeof(float)*(c)) -# define packd_c(a,b,c) memcpy((b),(char *)(a),sizeof(double)*(c)) -# define unpackd_c(a,b,c) memcpy((char *)(b),(a),sizeof(double)*(c)) -# define pack32_c(a,b,c) memcpy((b),(char *)(a),sizeof(int)*(c)) -# define unpack32_c(a,b,c) memcpy((char *)(b),(a),sizeof(int)*(c)) - -void pack16_c(int *in, char *out, int n); -void unpack16_c(char *in, int *out, int n); - -#else - -#if 1 -void pack16_c(int *in, char *out, int n); -void unpack16_c(char *in, int *out, int n); -void pack32_c(int *in, char *out, int n); -void unpack32_c(char *in, int *out, int n); -void pack64_c(int8 *in, char *out, int n); -void unpack64_c(char *in, int8 *out, int n); -void packr_c(float *in, char *out, int n); -void unpackr_c(char *in, float *out, int n); -void packd_c(double *in, char *out, int n); -void unpackd_c(char *in, double *out, int n); -#endif - -#endif -#endif - -#endif /* MIR_SYSDEP_H */ Index: casacore-3.5.0/mirlib/uvio.c =================================================================== --- casacore-3.5.0.orig/mirlib/uvio.c +++ /dev/null @@ -1,5056 +0,0 @@ -/************************************************************************/ -/* Bugs: */ -/* God only knows how many inconsistencies and bugs are left! */ -/* */ -/* History: */ -/* rjs ??????? Original version. */ -/* rjs 16aug89 Fixed bug, in uvread, of initialisation. */ -/* rjs 2oct89 Fixed need for nschan,restfreq for wide-only file. */ -/* rjs 18oct89 UV data selection code. Better planet treatment. Tidied */ -/* uvread. */ -/* rjs 1nov89 Fixed bug with the trueval array. */ -/* rjs 2nov89 Fixed bug when calculating velocity channels, and the */ -/* "amplitude", "phase", "real" and "imaginary" linetypes. */ -/* rjs 7nov89 Fixed bug in uvread_velocity, when velocity increment */ -/* is negative. Better error checking in UVSET. Bug with */ -/* window selection. */ -/* rjs 8nov89 Allowed you to select just 1 visibility in uvselect. */ -/* rjs 9nov89 Allow negative step parameter for velocity linetype. */ -/* Check for variable names greater than MAXNAM chars. */ -/* rjs 13nov89 Made uvnext so that it handles OLD as well as NEW files,*/ -/* as advertised. */ -/* rjs 2feb90 Added uvoverride, and modified uvscan, to implement the */ -/* capacity to override values of variables. */ -/* rjs 7feb90 If not linetype is set, uvread_init checks for both corr*/ -/* and wcorr before deciding on the default linetype. Added*/ -/* lots of comments! */ -/* rjs 13feb90 Modified uvinfo to handle object='bandwidth'. */ -/* rjs 12mar90 Significant mods to the uv selection stuff. Modified */ -/* uvinfo to handle object='frequency'. */ -/* rjs 23mar90 Fixed minor bug in uvselect. */ -/* rjs 27mar90 Fixed a bug where the UVF_COPY and UVF_UPDATE flags */ -/* where not properly set, when uvselect was skipping some */ -/* data. */ -/* rjs/bpw 6apr90 Greater control over amplitude selectoin. */ -/* pjt 8apr90 Made the CHECK macro more user understandable. rjs */ -/* re-installed the changes into this version. */ -/* rjs 10apr90 Wide flags, uvwread and uvwwrite. Added first_chan and */ -/* first_wind to the uv structure. */ -/* rjs 23apr90 Incorporated and enhanced pjt changes. Corrected a */ -/* comment. */ -/* rjs 24apr90 Fixed bug in uvread_select for RA selection. */ -/* rjs 25apr90 Enhancements to uvscan. */ -/* pjt 14aug90 Peter's TESTBED code. */ -/* rjs 16oct90 Improved uv_override somewhat. Changed uv selection */ -/* so that ant1 can equal ant2 (autocorrelation data). */ -/* rjs 17oct90 Handle selection by polarization and "on". */ -/* rjs 2nov90 Improved uv_override somewhat more. */ -/* rjs 14dec90 Fixed bug in uvread_select, when dra and ddec parameters*/ -/* are missing, but dra and ddec selection used. */ -/* rjs 8feb91 Fixed integer overflow problems in uvread_amp, and */ -/* amp flagging of H_CMPLX data. */ -/* rjs 11feb91 Added PJT's "testbed" (so he can sleep in comfort?), */ -/* uvselect for time treats a "Julian date" of less than 1 */ -/* as specifying the current day. Better checking for */ -/* uninitialised variables. Added the uvmark routine. Some */ -/* changes in uvread to fix a potential bug when wcorr and */ -/* corr do not always appear in the same record. */ -/* Allow dra,ddec selection, when dra,ddec missing. */ -/* Yet more work on uv_override. Corrected select=inc(1). */ -/* Bug when selecting non-existent channels. Added ability */ -/* to get sfreq from uvinfo. */ -/* pjt 28feb91 Added record count to TESTBED - declared uvopen_c() etc */ -/* rjs 1mar91 Corrected bug in uvmark. */ -/* rjs 5mar91 Fixed error in calculation of uvinfo(...,'sfreq',...) */ -/* uvwrite writes out u,v,t,bl only when needed. */ -/* Changed definitions of TESTBED offsets. */ -/* rjs 11mar91 Write out variables, in uvputvr, only when they really */ -/* change. Fixed two more bugs, which lint discovered. */ -/* rjs 19mar91 Added some more comments, and discovered a bug in uvinfo*/ -/* rjs 21mar91 Improved error message in uvgetvr. */ -/* rjs 22mar91 Just comments. */ -/* rjs 27mar91 More comments. Routine uvwflgwr. */ -/* rjs 16apr91 Added shadowing to uvselect. Always writes wcorr in */ -/* in uvwwrite. */ -/* rjs 18apr91 Change to uvset(...'corr'...) */ -/* rjs 29may91 Corrected planet scaling, in uvread_updated() */ -/* rjs 12jun91 Changed calculation of "restfreq" of wide channels. */ -/* What sense does it make? */ -/* rjs 19jun91 Corrected shadowing calculation. */ -/* rjs 5aug91 Improved some error messages a bit. */ -/* mjs 05aug91 Replaced hardcoded MAXANTS by maxdimc.h MAXANT */ -/* rjs 09oct91 Uvwread returns nread=0 if there are no wides, to */ -/* appease pjt. */ -/* rjs 22nov91 select=auto selects autocorrelations only. */ -/* rjs 13dec91 Added uvopen(..,'append') status. */ -/* rjs 9dec91 Minor enhancement to uvwrite, to handle case of */ -/* preamble variables being written somewhere else. */ -/* rjs 10jan92 Slight mod to uvwrite, to account for lgm program. */ -/* rjs 25mar92 Selection based on the frequency of the first channel */ -/* and the source name. */ -/* rjs 6apr92 Added specifying flags in runs form. The Convex found */ -/* found where I had forgotten a semi-colon. */ -/* rjs 12jun92 select=window makes sense for line=channel. */ -/* rjs 10jul92 one of the checks for linetype validity was incorrectly */ -/* too stringent. */ -/* mchw 29jul92 removed step<width check for channel linetype. */ -/* rjs 6aug92 Added uvvarini,uvvarset,uvvarcpy,uvvarupd. */ -/* rjs 17aug92 Deleted uvmark. Corrected minor bug in uvputvr. */ -/* rjs 20aug92 Appending when there is no data works. */ -/* rjs 16sep92 Check validity of window selection. */ -/* rjs 2nov92 Doc only. */ -/* rjs 22nov92 Better defaults when required variables not present in */ -/* selection. */ -/* rjs 9dec92 Fixed bug in shadowing, introduced 12 jun? */ -/* rjs 24dec92 Doc change only, at pjt's request. */ -/* rjs 10jan93 Add variance calculation to uvinfo. Get rid of int2. */ -/* rjs 12feb93 uvrdvr{i,r,d} now interconvert between int,float,double*/ -/* rjs 12feb93 uvselection of ra and dec cope with them being either */ -/* float or double. */ -/* rjs 3mar93 uvflush -- the way of the future. */ -/* rjs 16mar93 Always write vartable for new file if nvar==0. */ -/* rjs 29mar93 Changed formula for calculation of variance. */ -/* rjs 11may93 Get rid of abs() function, which accidently stayed. */ -/* rjs 13may93 Fix bug dealing with select=window in */ -/* uvinfo(..,'variance'..) */ -/* rjs 21jul93 Divide variance by 2 for Stokes parameters. */ -/* mjs 26aug93 cast strlen (elim ansi warning on solaris). */ -/* rjs 16nov93 Handle planet scaling when there are a mix of planets */ -/* and other sources. */ -/* rjs 23dec93 Added uvinfo(..,'felocity'..), and removed a few for */ -/* wideband channels that did not make much sense. */ -/* rjs 05jan94 Trivial doc changes only. */ -/* rjs 21jul94 Slightly better planet handling. */ -/* rjs 1aug94 Internal u-v-w re-calculation. Changes to the shadowing*/ -/* code. */ -/* rjs 30sep94 Fixed planet bug, which I must have introduced recently*/ -/* rjs 21oct94 Fix misleading error message. */ -/* rjs 6nov94 Change item and variable handle to an integer. */ -/* rjs 30nov94 Increase size of varnam by 1 char, in uvset_preamble. */ -/* rjs 9dec94 Less fussy when w coordinate is needed. */ -/* rjs 6jan95 Make buffer for "w" coordinate large enough! */ -/* rjs 13jan95 Added pulsar bin selection. */ -/* rjs 22feb95 Relax linetype step limitation in uvflgwr. */ -/* rjs 17apr96 uv_override can convert between numeric types. */ -/* rjs 15may96 Fiddles with roundup macro. */ -/* rjs 22nov96 Minor correction (spheroid correction) to planet flux */ -/* scaling. */ -/* rjs 18mar97 Plug minor memory leak. */ -/* rjs 15sep97 Fix error in pointing selection. */ -/* rjs 09oct97 Check for restfreq==0 when converting to velocity. */ -/* rjs 15oct97 Minor correction definition of felocity. */ -/* rjs 22oct97 Change in the format of "on" selection. */ -/* rjs 30aug99 Increase MAXVHANDS to 64 */ -/* rjs 31aug99 Correct an error message. */ -/* rjs 2sep99 Added average channel flagging tolerance. */ -/* rjs 16sep99 Corrections to velocity definitions. */ -/* rjs 4may00 Correct incorrect resetting of callno in uvrewind for */ -/* variables that have been overridden. */ -/* rjs 16jun00 Handle bad baseline numbers more gracefully. */ -/* rjs 16jan01 introduced large antennae numbers */ -/* pjt 11mar01 documented the 16jan01 changes for large ant numbers */ -/* dpr 17apr01 Increase MAXVHANDS */ -/* pjt 20jun02 MIR4 prototypes */ -/* pjt 14jan03 fix another forgotten int -> int8 */ -/* pjt 13may03 (04?) MAXIANT usage to limit MAXANT */ -/* pjt 03jan05 fix last few int -> size_t/off_t as per RJS's email */ -/* pjt 03jan05 MERGED IN THE ATNF CODE FOR: */ -/* rjs 27jul04 Handle uvinfo_variance Tsys table in a more elegant */ -/* fashion to deal with many antennas. (MAXANT) */ -/* rjs 16aug04 Add selection based on LST, elevation and HA - but */ -/* only when the relevant uv variables are in the dataset*/ -/* pjt 24oct05 TESTBED program can use checker table of uv variables */ -/* pjt 23nov05 Added new dazim, delev (scalar!) uv variables */ -/* only when the relevant uv variables are in the dataset*/ -/* pjt 25apr06 Add ATNF's new uvdim_c and match sourcenames w/o case */ -/* pjt 22aug06 merged versions; finish dazim/delev selection code */ -/* pjt 22may07 added code for purpose, fixed uvread_match() */ -/* pjt 06feb08 allow seeing() selection on smonrms or rmspath */ -/* cf. 08oct07 addition to ATNF version of uvio.c */ -/* pjt 8may08 wrap HA back into -12..12 from -24..24.. */ -/* dhem 13may08 Change uvputvr_c to always update var's buffer */ -/* dhem 14may08 uvputvr_c always reallocs var's buffer on size change */ -/* pjt 3dec09 allow minsize2 threshold on INT2 vs. REAL for corr's */ -/* pjt 16dec09 cloned uvread_match() into uvread_matchp() for purpose */ -/* pjt 22jul11 better antenna based handling ELEV, DAZIM, DELEV */ -/* pjt 31aug11 fix bug in ELEV selection */ -/* pkgw 05dec11 Move definition of MAXIANT here, reference the */ -/* thorough BASANT documentation. */ -/* pkgw 14dec11 Use errmsg_c() for cleaner I/O error reporting */ -/* pjt 6jun12 Merged in a few useful ATNF updates */ -/*----------------------------------------------------------------------*/ -/* */ -/* Handle UV files. */ -/* */ -/* A uv data set consists of the following data items: */ -/* visdata -- Varable stream. This data stream consists */ -/* of a stream of "records", each record giving either the */ -/* length or value of a "variable". Variables are anything */ -/* measured during an observation, and which can be */ -/* vary during the observation. These include uv */ -/* coordinate, correlation data, system temperature, time, */ -/* etc. Each record starts with 4 bytes which gives a */ -/* number identifying the variable, and indicates whether */ -/* this record give the variable's value or length (in */ -/* bytes). The identidying numbers range from 0 to N-1 */ -/* (for a file with info on N variables). */ -/* vartable -- Table of variable names and types. This is a text */ -/* item which which maps the number associated with a */ -/* variable into some more useable name. It also gives the */ -/* type (real, integer*2, double precision, etc) of */ -/* variables. */ -/* flags -- Flagging information. Each correlation has a flag */ -/* to indicate whether it is good or not. Flagging info is */ -/* written into an item consisting of a bit map. */ -/* */ -/* The UV structure */ -/* ================ */ -/* Each open UV data file is described by the UV structure, which in */ -/* turn contains a number of substructures. */ -/* */ -/* item This is the item-handle to access the variable */ -/* stream. */ -/* nvar The number of different variables in the */ -/* variable stream. */ -/* offset Current offset into uv data stream where i/o is */ -/* being performed. */ -/* tno The file-handle of the overall uv data-set. */ -/* flags Miscellaneous flags. */ -/* callno This is initially zero, and incremented each call to */ -/* uv_scan. */ -/* mark This gives the "callno" relative to which variables are */ -/* deemed to have been updated. i.e. a variable considered */ -/* as having changed if the variables "callno" is greater */ -/* or equal to "mark". */ -/* variable An array of structures defining the variables within the*/ -/* variable data stream. */ -/* vhash A hash table of pointers to VARIABLE structures. This */ -/* allows fast access to the a particular variable by name.*/ -/* data_line A structure (LINE_INFO) describing the data line type. */ -/* ref_line A structure (LINE_INFO) describing the reference line */ -/* type. */ -/* sel The uv data selection structure. */ -/* corr_flags.handle Handle used by the maskio routines. */ -/* corr_flags.offset Offset to the next flag to read in the mask file. */ -/* corr_flags.nflags Number of correlation channel flags. */ -/* corr_flags.flags The flags for the last correlation record read. */ -/* corr_flags.init Have they been read? */ -/* corr_flags.exists A flag whether the corr flags are believed to exist.*/ -/* */ -/* Because we know that certain variables are accessed every call to */ -/* uvread, we keep pointers to them. */ -/* */ -/* coord corr tscale time */ -/* bl nschan sfreq sdf */ -/* restfreq axisrms dra ddec */ -/* nwide wcorr wfreq veldop */ -/* vsource plmaj plmin plangle */ -/* ra dec pol on */ -/* obsra obsdec lst antpos */ -/* antdiam source pol smonrms */ -/* rmspath */ -/* */ -/* The VARIABLE structure */ -/* ====================== */ -/* This structure describes a single variable from the variable data */ -/* stream. */ -/* buf Pointer to a buffer containing the current value of the */ -/* variable (in the format of the local machine). */ -/* name The name of the variable. */ -/* length The length of the variable (bytes). */ -/* flags Miscellaneous flags. */ -/* type The type of the variable, whether it is I*2,R*4, etc. */ -/* index This gives the index of the variable in the "variable" */ -/* array of the UV structure. */ -/* callno The call number to uv_scan when the variable was last */ -/* updated. */ -/* fwd Pointer to the next variable. This allows a linked */ -/* list to be formed for hashing. */ -/* */ -/*----------------------------------------------------------------------*/ -#if defined(HAVE_CONFIG_H) && HAVE_CONFIG_H -#include "config.h" -#endif - -#define VERSION_ID "6-june-2012 pjt" - -#define private static - -#define CKMS 299792.458 -#define PI 3.141592653589793 - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <math.h> -#include <ctype.h> -#include "hio.h" -#include "miriad.h" - -#define UVF_COPY 0x01 /* Set if this variable is to be copied by - the uvcopy routine. */ -#define UVF_UPDATED 0x02 /* Set if noting updates to this variable. */ -#define UVF_UPDATED_PLANET 0x04 /* Set if planet things have changed. */ -#define UVF_UPDATED_SKYFREQ 0x08 /* Set if sky freq things have changed. */ -#define UVF_NEW 0x10 /* Set if its a new uv data set being made. */ -#define UVF_APPEND 0x20 /* Set if we are appending to a uv dataset. */ -#define UVF_WAVELENGTH 0x40 /* Set if uvread is to convert uv to wavelengths. */ -#define UVF_OVERRIDE 0x80 /* Set if the value of this variable is being - overriden. */ -#define UVF_NOCHECK 0x200 /* Set if UVPUTVR is not to check this variable - as to whether it has really changed. */ -#define UVF_AUTO 0x400 -#define UVF_CROSS 0x800 - -#define UVF_RUNS 0x1000 /* Does uvwrite receive flags in runs - specification? */ -#define UVF_INIT 0x2000 /* Set on first call to uvread or uvwrite. */ -#define UVF_UPDATED_UVW 0x4000 /* Set if things needed for uvw have changed. */ -#define UVF_REDO_UVW 0x8000 /* Set if u-v-w are to be recomputed. */ -#define UVF_DOW 0x10000 /* Set if the caller wants w returned. */ - -#define UV_ALIGN 8 -#define UV_HDR_SIZE 4 - -#define CHECK_THRESH 6 -#define HASHSIZE 123 -#define MAXVAR 256 -#define MAXNAM 8 -#define MAXPRE 9 -#define MAXLINE 128 -#define VAR_SIZE 0 -#define VAR_DATA 1 -#define VAR_EOR 2 - -#define MK_FLAGS 1 -#define MK_RUNS 2 - -/*----------------------------------------------------------------------*/ -/* */ -/* A few definitions to coax lint to like my code. */ -/* */ -/*----------------------------------------------------------------------*/ - -#define Sscanf (void)sscanf -#define Sprintf (void)sprintf -#define Malloc(x) malloc((unsigned)(x)) -#define Realloc(a,b) ((a)==NULL?malloc((unsigned)(b)):realloc((a),(unsigned)(b))) -#define Strcpy (void)strcpy - -/*----------------------------------------------------------------------*/ -/* */ -/* Macros to simplify life and obscure the debugger :-) */ -/* */ -/*----------------------------------------------------------------------*/ - -#define BUG(sev,a) bug_c(sev,a) -#define ERROR(sev,a) bug_c(sev,((void)sprintf a,message)) -#define CHECK(x,a) if(x) { Sprintf a; bugv_c('f', "%s: %s", \ - message, errmsg_c (x)); } - -#define uvputvra_c(tno,name,value) \ - uvputvr_c(tno,H_BYTE,name,value,strlen(value)) -#define uvputvrj_c(tno,name,value,n) \ - uvputvr_c(tno,H_INT2,name,(char *)(value),n) -#define uvputvri_c(tno,name,value,n) \ - uvputvr_c(tno,H_INT,name,(char *)(value),n) -#define uvputvrr_c(tno,name,value,n) \ - uvputvr_c(tno,H_REAL,name,(char *)(value),n) -#define uvputvrd_c(tno,name,value,n) \ - uvputvr_c(tno,H_DBLE,name,(char *)(value),n) -#define uvputvrc_c(tno,name,value,n) \ - uvputvr_c(tno,H_CMPLX,name,(char *)(value),n) - -#define VARLEN(var) ( (var)->length / external_size[(var)->type] ) -#define VARTYPE(var) ( type_flag[(var)->type] ) - -#define NUMCHAN(var) ((var)->type == H_INT2 || (var)->type == H_REAL ? \ - (var)->length / (2*external_size[(var)->type]) : \ - (var)->length / external_size[(var)->type] ) - -#define MYABS(x) ( (x) > 0 ? (x) : -(x) ) - -/*----------------------------------------------------------------------*/ -/* */ -/* Types and static variables. */ -/* */ -/*----------------------------------------------------------------------*/ - -static char message[MAXLINE]; -static int internal_size[10]; -static int external_size[10]; -static char type_flag[10]; - -static char var_data_hdr[UV_HDR_SIZE]={0,0,VAR_DATA,0}; -static char var_size_hdr[UV_HDR_SIZE]={0,0,VAR_SIZE,0}; -static char var_eor_hdr[UV_HDR_SIZE]={0,0,VAR_EOR,0}; - - -typedef struct variable{ - char *buf,name[MAXNAM+1]; - int length,flength,flags,type,index,callno; - struct variable *fwd; -} VARIABLE; - -typedef struct varpnt{ - VARIABLE *v; - struct varpnt *fwd; -} VARPNT; - -typedef struct varhand{ - int tno,callno,index; - struct varhand *fwd; - VARPNT *varhd; -} VARHAND; - -#define LINE_NONE 0 -#define LINE_CHANNEL 1 -#define LINE_WIDE 2 -#define LINE_VELOCITY 3 -#define LINE_FELOCITY 4 - -#include "maxdimc.h" - -#define SEL_VIS 1 -#define SEL_TIME 2 -#define SEL_UVN 3 -#define SEL_POINT 4 -#define SEL_DRA 5 -#define SEL_DDEC 6 -#define SEL_INC 7 -#define SEL_RA 8 -#define SEL_DEC 9 -#define SEL_POL 10 -#define SEL_ON 11 -#define SEL_SRC 12 -#define SEL_UV 13 -#define SEL_FREQ 14 -#define SEL_SHADOW 15 -#define SEL_BIN 16 -#define SEL_HA 17 -#define SEL_LST 18 -#define SEL_ELEV 19 -#define SEL_DAZIM 20 -#define SEL_DELEV 21 -#define SEL_PURP 22 -#define SEL_SEEING 23 - -typedef struct { - int type,discard; - double loval,hival; - char *stval; -} OPERS; - -typedef struct { - int discard,select; - float loval,hival; -} AMP; - -typedef struct { - int wins[MAXWIN]; - int first,last,n,select; -} WINDOW; - -typedef struct { double *table; - int vhan,nants,missing; -} SIGMA2; - -typedef struct select { - int ants[MAXANT*(MAXANT+1)/2]; - int selants; - int maxoper,noper,and; - WINDOW win; - AMP amp; - OPERS *opers; - struct select *fwd; -} SELECT; - -typedef struct { - int nants; - double uu[MAXANT],vv[MAXANT],ww[MAXANT]; -} UVW; - -typedef struct { - int linetype; - int start,width,step,n; - float fstart,fwidth,fstep,*wts; -} LINE_INFO; - -typedef struct { - char *handle; - int nflags,*flags,exists,init; - off_t offset; -} FLAGS; - -typedef struct { - int item; - int nvar,saved_nvar,tno,flags,callno,maxvis,mark; - int minsize2; /* at -1 always use REAL, else use to trigger INT2 */ - off_t offset, max_offset; - int presize,gflag; - FLAGS corr_flags,wcorr_flags; - VARIABLE *coord,*corr,*time,*bl,*tscale,*nschan,*axisrms,*seeing; - VARIABLE *sfreq,*sdf,*restfreq,*wcorr,*wfreq,*veldop,*vsource; - VARIABLE *plmaj,*plmin,*plangle,*dra,*ddec,*ra,*dec,*pol,*on; - VARIABLE *dazim, *delev, *purpose; - VARIABLE *obsra,*obsdec,*lst,*elev,*antpos,*antdiam,*source,*bin; - VARIABLE *vhash[HASHSIZE],*prevar[MAXPRE]; - VARIABLE variable[MAXVAR]; - LINE_INFO data_line,ref_line,actual_line; - int need_skyfreq,need_point,need_planet,need_dra,need_ddec, - need_dazim, need_delev,need_purp, - need_ra,need_dec,need_pol,need_on,need_obsra,need_uvw,need_src, - need_win,need_bin,need_lst,need_elev,need_seeing; - float ref_plmaj,ref_plmin,ref_plangle,plscale,pluu,pluv,plvu,plvv; - double skyfreq; - int skyfreq_start; - VARHAND *vhans; - SELECT *select; - int apply_amp,apply_win; - AMP *amp; - SIGMA2 sigma2; - UVW *uvw; - WINDOW *win; -} UV; - -#define MAXVHANDS 128 - -static UV *uvs[MAXOPEN]; -static VARHAND *varhands[MAXVHANDS]; -static WINDOW truewin; -static AMP noamp; -static int first=TRUE; - -/* void uvputvr_c(); */ -private void uvinfo_chan(),uvinfo_variance(),uvbasant_c(); -private void uv_init(),uv_freeuv(),uv_free_select(); -private void uvread_defline(),uvread_init(),uvread_velocity(),uvread_flags(); -private void uvread_defvelline(); -private void uvread_updated_planet(),uvread_reference(); -private void uvread_updated_uvw(),uvread_preamble(); -private void uv_vartable_out(),uv_vartable_in(); -private void uvset_coord(),uvset_linetype(),uvset_planet(); -private void uvset_selection(),uvset_preamble(); -private void uv_addopers(),uv_override(); -private UV *uv_getuv(); -private VARIABLE *uv_mkvar(),*uv_locvar(),*uv_checkvar(); -private int uv_scan(),uvread_line(),uvread_select(),uvread_maxvis(); -private int uvread_shadowed(),uvread_match(),uvread_matchp(); -private double uv_getskyfreq(); - -/************************************************************************/ -#ifdef TESTBED -static char *M[] = { - "JAN", "FEB", "MAR", "APR", "MAY", "JUN", - "JUL", "AUG", "SEP", "OCT", "NOV", "DEC" -}; - -static int checklist = 0; - -/* The following compiles a main program to give exercise to some of the - * uvio routines. It is essentially a debugging device (both for bad - * files and bad behaviour of uvio!). - * - * Call several uvio.c routines, some of which are the non-public ones, - * to get a 'human' readable listing of a miriad visibility data set ` - * Because it needs some of these 'static' routines, the source code - * of uvio.c needs to be included here directly, as opposed to linking - * it with the library ($MIRLIB/libmir.a in Unix) - * - * Note: This program does not have the normal miriad user interface - * - */ -int main(int ac,char *av[]) -{ - int i,tno; - char *fn; - - printf("%s Version %s\n",av[0],VERSION_ID); - if (ac!=2) { - printf("Usage: %s [vis=]vis-dataset\n",av[0]); - printf("Expert listing of a miriad UV dataset\n"); -#ifdef MIR4 - printf("MIR4 mode\n"); -#else - printf("MIR3 mode **probably will not work in MIR4**\n"); -#endif - exit(0); - } - - for (i=1; i<ac; i++) { /* loop over command line arguments */ - fn = av[i]; - if ((int)strlen(fn) > 4) { /* see if vis= was used */ - if (strncmp(fn,"vis=",4)==0) - fn += 4; /* if so, increase pointer */ - } - uvopen_c(&tno,fn,"old"); - } - my_uvlist(tno,fn); - uvclose_c(tno); - return 0; -} - - -my_uvlist(int tno,char *fname) -{ - double *dp; - float *fp; - short *sp; - int iostat, intsize, extsize, i, *ip, eor_count=0; - off_t offset; - VARIABLE *v; - UV *uv; - char s[UV_HDR_SIZE], *b, buffer[128]; - - - uv = uvs[tno]; /* get pointer to UV structure */ - - offset = uv->offset; /* should be 0 at start */ - printf("0x%08x FILE: %s\n",offset,fname); - while(offset < uv->max_offset) { - printf("0x%08x ",offset); - hreadb_c(uv->item,s,offset,UV_HDR_SIZE,&iostat); /* get header */ - if (iostat == -1) return(iostat); /* End Of File */ - - if(*(s+2) != VAR_EOR) { - v = &uv->variable[*s]; /* get name of var */ - intsize = internal_size[v->type]; - extsize = external_size[v->type]; - } - - switch(*(s+2)) { - case VAR_SIZE: - hreadi_c(uv->item,&v->length,offset+UV_HDR_SIZE,H_INT_SIZE, - &iostat); - printf("SIZE: %-9s Count=%d,Type=%c\n",v->name,VARLEN(v),VARTYPE(v)); - v->buf = Realloc(v->buf, (v->length*intsize)/extsize); - offset += UV_ALIGN; - break; - case VAR_DATA: - offset += mroundup(UV_HDR_SIZE,extsize); - hread_c(uv->item,v->type,v->buf,offset,v->length, - &iostat); - printf("DATA: %-9s",v->name); - if (strcmp(v->name,"time") == 0) { - int z,a,b,c,d,e,alpha,month,year,day,hr,minute,sec; - int dsec,nchar; - char string[100]; - double f; - - dp = (double *) v->buf; - z = *dp + 0.5 + (1.0/1728000.0); - f = *dp + 0.5 + (1.0/1728000.0) - z; - if (z<2299161){a=z;}else{ - alpha = ((z - 1867216.25) / 36524.25); - a = z + 1 + alpha - (int)(0.25 * alpha); - } - b = a + 1524; c = (b - 122.1) / 365.25; - d = 365.25 * c; e = (b - d) / 30.6001; - f += (b - d - (int)(30.6001 * e)); - day = f; hr = 24 * (f - day); - minute = 60 * (24 * (f - day) - hr); - sec = 600 * (60 * (24 * (f - day) - hr) - minute); - dsec = sec % 10; sec /= 10; - month = (e<=13) ? e - 1 : e - 13; - year = (month>2) ? c - 4716 : c - 4715; - year %= 100; - printf(" %20.10lg ",*dp); - printf(" %2.2d%s%2.2d:%2.2d:%2.2d:%2.2d.%1d\n", - year,M[month-1],day,hr,minute,sec,dsec); - }else - switch (v->type) { - case H_BYTE: - strncpy(buffer,v->buf,v->length); - buffer[v->length] = 0; - printf(" %-8s\n",buffer); - break; - case H_INT2: - sp = (short *) v->buf; - printf(" %d\n",*sp); - break; - case H_INT: - ip = (int *) v->buf; - printf(" %d\n",*ip); - break; - case H_REAL: - fp = (float *) v->buf; - printf(" %20.10g\n",*fp); - break; - case H_DBLE: - dp = (double *) v->buf; - printf(" %20.10lg\n",*dp); - break; - case H_CMPLX: - fp = (float *) v->buf; - printf(" %20.10g %20.10g\n",fp[0], fp[1]); - break; - default: - printf(" (Invalid data type %d)\n",v->type); - break; - } - offset = mroundup(offset+v->length,UV_ALIGN); - break; - case VAR_EOR: - printf("========== EOR (%d) ========\n",++eor_count); - offset += UV_ALIGN; - break; - default: - printf("No valid record code %d",*(s+2)); - exit(0); - } /* switch */ - uv->offset = offset; - } /* for(;;) */ -} -#endif -/************************************************************************/ -void uvopen_c(int *tno,Const char *name,Const char *status) -/**UvOpen -- Open a uv data file. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvopen(tno,name,status) - integer tno - character name*(*),status*(*) - - Create and/or ready a UV data base to be accessed. - - Input: - name Name of the directory tree containg the u-v data. - status Either "old", "new" or "append". Old files can be read, - whereas new and append files can only be written. Append - files must be pre-existing uv data-sets. - Output: - tno Handle of the uv data set. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - int iostat; - char line[MAXLINE]; - - if(first)uv_init(); - -/*----------------------------------------------------------------------*/ -/* */ -/* Handle an old file. */ -/* */ -/*----------------------------------------------------------------------*/ - - if( !strcmp(status,"old") ) { - hopen_c(tno,name,"old",&iostat); - CHECK(iostat,(message,"Error opening %s, in UVOPEN(old)",name)); - uv = uv_getuv(*tno); - haccess_c(*tno,&uv->item,"visdata","read",&iostat); - CHECK(iostat,(message,"Error accessing visdata for %s, in UVOPEN(old)",name)); -#ifdef MIR4 - /* figure out if to read old MIR3 or new MIR4 */ -#if true - rdhdl_c(*tno,"vislen",&(uv->max_offset),hsize_c(uv->item)); -#else - int old_vislen; - rdhdi_c(*tno,"vislen",&old_vislen,hsize_c(uv->item)); - if (old_vislen < 0) - ERROR('f',(message,"Bad conversion MIR3<->MIR4 in UVOPEN: vislen=%d",old_vislen)); - uv->max_offset = old_vislen; -#endif -#else - /* MIR3 and before format: */ - rdhdi_c(*tno,"vislen",&(uv->max_offset),hsize_c(uv->item)); -#endif - uv_vartable_in(uv); - uv_override(uv); - -/*----------------------------------------------------------------------*/ -/* */ -/* Handle a new file. */ -/* */ -/*----------------------------------------------------------------------*/ - - } else if(!strcmp(status,"new")) { - hopen_c(tno,name,"new",&iostat); - CHECK(iostat,(message,"Error opening %s, in UVOPEN(new)",name)); - uv = uv_getuv(*tno); - haccess_c(*tno,&uv->item,"visdata","write",&iostat); - CHECK(iostat,(message,"Error accessing visdata for %s, in UVOPEN(new)",name)); - uv->flags = UVF_NEW; - -/*----------------------------------------------------------------------*/ -/* */ -/* Append to an old file. */ -/* */ -/*----------------------------------------------------------------------*/ - - } else if(!strcmp(status,"append")) { - hopen_c(tno,name,"old",&iostat); - CHECK(iostat,(message,"Error opening %s, in UVOPEN(append)",name)); - uv = uv_getuv(*tno); - haccess_c(*tno,&uv->item,"visdata","append",&iostat); - CHECK(iostat,(message,"Error accessing visdata for %s, in UVOPEN(append)",name)); - uv->flags = UVF_APPEND; -#ifdef MIR4 - /* figure out if to read old MIR3 or new MIR4 */ - if (1) { - rdhdl_c(*tno,"vislen",&(uv->offset),hsize_c(uv->item)); - } else { - int old_vislen; - rdhdi_c(*tno,"vislen",&old_vislen,hsize_c(uv->item)); - if (old_vislen < 0) - ERROR('f',(message,"Bad conversion MIR3<->MIR4 in UVOPEN: vislen=%d",old_vislen)); - uv->offset = old_vislen; - } -#else - /* MIR3 and before format: */ - rdhdi_c(*tno,"vislen",&(uv->offset),hsize_c(uv->item)); -#endif - uv->offset = mroundup(uv->offset,UV_ALIGN); - uv_vartable_in(uv); - -/* Read items and fill in the appropriate value. */ - - rdhda_c(*tno,"obstype",line,"",MAXLINE); - if(!strcmp(line,"autocorrelation")) uv->flags |= UVF_AUTO; - else if(!strcmp(line,"crosscorrelation")) uv->flags |= UVF_CROSS; - rdhdl_c(*tno,"ncorr",&(uv->corr_flags.offset),-1); - rdhdl_c(*tno,"nwcorr",&(uv->wcorr_flags.offset),-1); - if(uv->corr_flags.offset < 0 || uv->wcorr_flags.offset < 0) - BUG('f',"Cannot append to uv file without 'ncorr' and/or 'nwcorr' items"); - -/*----------------------------------------------------------------------*/ -/* */ -/* Somethig else -- must be an error. */ -/* */ -/*----------------------------------------------------------------------*/ - - } else ERROR('f',(message,"Status %s is not recognised by UVOPEN",status)); -} -/************************************************************************/ -void uvclose_c(int tno) -/**uvclose -- Close a uv file */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - subroutine uvclose(tno) - integer tno - - This close a uv data file. - Input: - tno Handle of the uv data set. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - int iostat; - - uv = uvs[tno]; - -/* Finished with the flagging information. */ - - if(uv->corr_flags.handle != NULL) mkclose_c(uv->corr_flags.handle); - if(uv->wcorr_flags.handle != NULL) mkclose_c(uv->wcorr_flags.handle); - uv->corr_flags.handle = uv->wcorr_flags.handle = NULL; - -/* Flush out all stuff appropriate for a new or append file. */ - - if(uv->flags & (UVF_NEW|UVF_APPEND))uvflush_c(tno); - -/* Close the visibility data stream, release structures, and close the - whole thing. */ - - hdaccess_c(uv->item,&iostat); - CHECK(iostat,(message,"Error calling hdaccess for visdata, in UVCLOSE")); - uv_freeuv(uv); - uvs[tno] = NULL; - hclose_c(tno); -} -/************************************************************************/ -void uvflush_c(int tno) -/**uvflush -- Flush buffers of a uv dataset to disk. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - subroutine uvflush(tno) - integer tno - - This close a uv data file. - Input: - tno Make sure anything buffered up is flushed to disk. The - disk file should be readable (up to data written here) - even if the caller or computer crashes. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - int iostat; - - uv = uvs[tno]; - - if(!(uv->flags & (UVF_NEW|UVF_APPEND)))return; - -/* Flush the masks out. */ - - if(uv->corr_flags.handle != NULL) mkflush_c(uv->corr_flags.handle); - if(uv->wcorr_flags.handle != NULL) mkflush_c(uv->wcorr_flags.handle); - -/* Rewrite vartable, if needed. */ - - if(uv->saved_nvar < uv->nvar || (uv->nvar == 0 && (uv->flags & UVF_NEW))) uv_vartable_out(uv); - uv->saved_nvar = uv->nvar; - -/* Rewrite the description indicating the type of the data. */ - - if( ( uv->flags & (UVF_AUTO|UVF_CROSS) ) == (UVF_AUTO|UVF_CROSS)) - wrhda_c(tno,"obstype","mixed-auto-cross"); - else if(uv->flags & UVF_AUTO) - wrhda_c(tno,"obstype","autocorrelation"); - else if(uv->flags & UVF_CROSS) - wrhda_c(tno,"obstype","crosscorrelation"); - -/* Write out things to help recover the EOF. */ - -#ifdef MIR4 - wrhdl_c(tno,"nwcorr",uv->wcorr_flags.offset); - wrhdl_c(tno,"ncorr",uv->corr_flags.offset); - wrhdl_c(tno,"vislen",uv->offset); -#else - /* old MIR3 and before format */ - wrhdi_c(tno,"nwcorr",uv->wcorr_flags.offset); - wrhdi_c(tno,"ncorr",uv->corr_flags.offset); - wrhdi_c(tno,"vislen",uv->offset); -#endif - -/* Finally flush out everything to disk. */ - - hflush_c(tno,&iostat); - CHECK(iostat,(message,"Error calling hflush, in UVFLSH")); -} -/************************************************************************/ -private void uv_init() -/* - Initalise everything imaginable. -------------------------------------------------------------------------*/ -{ - int i; - - first = FALSE; - - external_size[H_BYTE] = 1; internal_size[H_BYTE] = 1; - type_flag[H_BYTE] = 'a'; - external_size[H_INT] = H_INT_SIZE; internal_size[H_INT] = sizeof(int); - type_flag[H_INT] = 'i'; - external_size[H_INT2] = H_INT2_SIZE; internal_size[H_INT2] = sizeof(int); - type_flag[H_INT2] = 'j'; - external_size[H_REAL] = H_REAL_SIZE; internal_size[H_REAL] = sizeof(float); - type_flag[H_REAL] = 'r'; - external_size[H_DBLE] = H_DBLE_SIZE; internal_size[H_DBLE] = sizeof(double); - type_flag[H_DBLE] = 'd'; - external_size[H_CMPLX] = H_CMPLX_SIZE; - internal_size[H_CMPLX] = 2*sizeof(float); - type_flag[H_CMPLX] = 'c'; - -/* Initialise the "true window" array. */ - - noamp.select = FALSE; - - truewin.first = 0; - truewin.last = MAXWIN-1; - truewin.n = MAXWIN; - truewin.select= FALSE; - for(i=0; i < MAXWIN; i++) truewin.wins[i] = TRUE; - -/* Initialise the table of variable handles. */ - - for(i=0; i < MAXVHANDS; i++)varhands[i] = NULL; - -} -/************************************************************************/ -private void uv_freeuv(UV *uv) -/* - Free a uv structure. -------------------------------------------------------------------------*/ -{ - int i; - VARIABLE *v; - VARHAND *vh,*vht; - VARPNT *vp,*vpt; - - vh = uv->vhans; - while(vh != NULL){ - vp = vh->varhd; - varhands[vh->index] = NULL; - while(vp != NULL){ - vpt = vp; - vp = vp->fwd; - free((char *)vpt); - } - vht = vh; - vh = vh->fwd; - free((char *)vht); - } - -/* Free buffers associated with variables. */ - - for(i=0, v = uv->variable; i < MAXVAR; i++, v++) - if(v->buf != NULL)free(v->buf); - - if(uv->data_line.wts != NULL) free((char *)uv->data_line.wts); - if(uv->ref_line.wts != NULL) free((char *)uv->ref_line.wts); - if(uv->corr_flags.flags != NULL) free((char *)uv->corr_flags.flags); - if(uv->wcorr_flags.flags != NULL ) free((char *)uv->wcorr_flags.flags); - if(uv->sigma2.table != NULL)free((char *)uv->sigma2.table); - uv_free_select(uv->select); - if(uv->uvw != NULL) free((char *)(uv->uvw)); - free((char *)uv); -} -/************************************************************************/ -private void uv_free_select(SELECT *sel) -{ - OPERS *op; - SELECT *fwd; - int i; - - while(sel != NULL){ - fwd = sel->fwd; - if(sel->noper > 0){ - op = sel->opers; - for(i=0; i < sel->noper; i++){ - if(op->stval != NULL) free(op->stval); - op++; - } - free((char *)(sel->opers)); - } - free((char *)sel); - sel = fwd; - } -} -/************************************************************************/ -private UV *uv_getuv(int tno) -/* - Allocate a structure describing a uv file. -------------------------------------------------------------------------*/ -{ - int i; - UV *uv; - VARIABLE *v; - - uv = (UV *)Malloc(sizeof(UV)); - uv->item = 0; - uv->tno = tno; - uv->vhans = NULL; - uv->nvar = 0; - uv->presize = 0; - uv->minsize2 = 4; /* trigger REAL (vs. INT2) storage, or -1 for always */ - uv->gflag = 1; - uv->saved_nvar= 0; - uv->offset = 0; - uv->max_offset= 0; - uv->flags = 0; - uv->callno = 0; - uv->maxvis = 0; - uv->mark = 0; - uv->select = NULL; - uv->need_skyfreq = uv->need_point = uv->need_planet = FALSE; - uv->need_pol = uv->need_on = uv->need_uvw = FALSE; - uv->need_src = uv->need_win = uv->need_bin = FALSE; - uv->need_dra = uv->need_ddec = uv->need_ra = FALSE; - uv->need_dec = uv->need_lst = uv->need_elev = FALSE; - uv->need_obsra = uv->need_dazim = uv->need_delev = FALSE; - uv->need_purp = uv->need_seeing= FALSE; - uv->uvw = NULL; - uv->ref_plmaj = uv->ref_plmin = uv->ref_plangle = 0; - uv->plscale = 1; - uv->pluu = uv->plvv = 1; - uv->plvu = uv->pluv = 0; - uv->apply_amp = TRUE; - uv->apply_win = TRUE; - uv->skyfreq_start = 0; - - uv->corr_flags.exists = TRUE; - uv->corr_flags.handle = NULL; - uv->corr_flags.offset = 0; - uv->corr_flags.flags = NULL; - uv->corr_flags.nflags = 0; - uv->wcorr_flags.exists = TRUE; - uv->wcorr_flags.handle = NULL; - uv->wcorr_flags.offset = 0; - uv->wcorr_flags.flags = NULL; - uv->wcorr_flags.nflags = 0; - - uv->data_line.wts = NULL; - uv->data_line.linetype = LINE_NONE; - uv->ref_line.wts = NULL; - uv->ref_line.linetype = LINE_NONE; - - uv->sigma2.table = NULL; - uv->sigma2.nants = 0; - uv->sigma2.missing = FALSE; - - uv->corr = NULL; - uv->wcorr = NULL; - uv->coord = NULL; - uv->time = NULL; - uv->bl = NULL; - - for(i=0, v = uv->variable; i < MAXVAR; i++, v++){ - v->length = v->flength = 0; - v->buf = NULL; - v->flags = 0; - v->type = 0; - v->fwd = NULL; - v->index = i; - v->callno = 0; - } - for(i=0; i < HASHSIZE; i++) uv->vhash[i] = NULL; - uvs[tno] = uv; - return(uv); -} -/************************************************************************/ -private void uv_vartable_out(UV *uv) -/* - Write out a variable name table. -------------------------------------------------------------------------*/ -{ - int item; - char line[MAXLINE]; - int iostat,i; - VARIABLE *v; - - haccess_c(uv->tno,&item,"vartable","write",&iostat); - CHECK(iostat,(message,"Error opening vartable, in UVCLOSE(vartable_out)")); - for(i=0, v = uv->variable; i < uv->nvar; i++,v++){ - Sprintf(line,"%c %s",VARTYPE(v),v->name); - hwritea_c(item,line,strlen(line)+1,&iostat); - CHECK(iostat,(message,"Error writing to vartable, in UVCLOSE(vartable_out)")); - } - hdaccess_c(item,&iostat); - CHECK(iostat,(message,"Error closing vartable, in UVCLOSE(vartable_out)")); -} -/************************************************************************/ -private void uv_override(UV *uv) -/* - Determine if a variable has a item of the same name. If there is one, then - the value of that item overrides the value of the variable. In this case, - get the value of the item, and set a flag to indicate that the variable - value is being overriden. -------------------------------------------------------------------------*/ -{ - int item; - char *b,varname[MAXLINE],vartype[MAXLINE],descr[MAXLINE]; - VARIABLE *v; - int tno,iostat,n,ok,isnumeric,ischar; - - tno = uv->tno; - haccess_c(uv->tno,&item,".","read",&iostat); - CHECK(iostat,(message,"Error opening directory listing, in UVOPEN(override)")); - while(hreada_c(item,varname,MAXLINE,&iostat),iostat==0){ - v = uv_locvar(tno,varname); - if(v != NULL){ - hdprobe_c(tno,varname,descr,MAXLINE,vartype,&n); - isnumeric = - (v->type == H_DBLE || v->type == H_REAL || v->type == H_INT) && - (!strcmp(vartype,"double") || !strcmp(vartype,"real") || - !strcmp(vartype,"integer")); - ischar = (v->type == H_BYTE && !strcmp(vartype,"character")); - ok = ( n == 1 && (isnumeric || ischar) ); - - if(v->type == H_BYTE) { - n = strlen(descr); - b = Malloc(n+1); - } else { - b = Malloc(internal_size[v->type]); - } - if(ok)switch(v->type){ - case H_INT: rdhdi_c(tno,varname,(int *)b,0); break; - case H_REAL: rdhdr_c(tno,varname,(float *)b,0.0); break; - case H_BYTE: strcpy(b,descr); break; - case H_DBLE: rdhdd_c(tno,varname,(double *)b,(double)0.0); break; - default: ok = FALSE; - } - if(ok){ - v->flags |= UVF_OVERRIDE; - v->buf = b; - v->length = n*external_size[v->type]; - v->callno = 1; - } else { - free(b); - ERROR('w',(message,"Cannot override variable %s, in UVOPEN",varname)); - } - } - } - if(iostat != -1) ERROR('f',(message, - "Error %d when performing override checks, in UVOPEN",iostat)); - hdaccess_c(item,&iostat); -} -/************************************************************************/ -private void uv_vartable_in(UV *uv) -/* - Scan the variable name table, to determine the names and types of the - variables. -------------------------------------------------------------------------*/ -{ - int item; - char line[MAXLINE],name[MAXNAM+1],ctype; - int iostat,type; - - haccess_c(uv->tno,&item,"vartable","read",&iostat); - CHECK(iostat,(message,"Error opening vartable, in UVOPEN(vartable_in)")); - - while(hreada_c(item,line,(int)sizeof(line),&iostat),!iostat){ - Sscanf(line,"%c %s",&ctype,name); - switch(ctype){ - case 'a': type = H_BYTE; break; - case 'j': type = H_INT2; break; - case 'i': type = H_INT; break; - case 'r': type = H_REAL; break; - case 'd': type = H_DBLE; break; - case 'c': type = H_CMPLX; break; - default: ERROR('f',(message,"Bad type (%c) for variable %s",ctype,name)); - } - (void)uv_mkvar(uv->tno,name,type); - } - hdaccess_c(item,&iostat); - uv->saved_nvar = uv->nvar; -} -/************************************************************************/ -private VARIABLE *uv_mkvar(int tno,char *name,int type) -/* - Add an entry for a new variable. -------------------------------------------------------------------------*/ -{ - UV *uv; - VARIABLE *v; - int n,hashval; - -/* Check if the variable already exists. */ - - v = uv_locvar(tno,name); - if(v != NULL) return(v); - -/* Check that the variable has a good name. */ - if((int)strlen(name) > MAXNAM) - ERROR('f',(message,"The variable name %s is too long, in UVPUTVR",name)); - -/* We are going to have to create it. */ - - uv = uvs[tno]; - n = uv->nvar++; - v = &uv->variable[n]; - Strcpy(v->name,name); - v->type = type; - -/* Add it to the hash table. */ - - hashval = 0; - while(*name)hashval += *name++; - hashval %= HASHSIZE; - v->fwd = uv->vhash[hashval]; - uv->vhash[hashval] = v; - - return(v); -} -/************************************************************************/ -private VARIABLE *uv_locvar(int tno,char *name) -/* - Locate a variable from the hash table. -------------------------------------------------------------------------*/ -{ - VARIABLE *v; - int hashval; - char *s; - - hashval = 0; - for(s=name; *s; s++) hashval += *s; - - for(v = uvs[tno]->vhash[hashval%HASHSIZE]; v != NULL; v = v->fwd) - if(!strcmp(v->name,name))break; - return(v); -} -/************************************************************************/ -void uvnext_c(int tno) -/**uvnext -- Skip to the next uv record. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - subroutine uvnext(tno) - integer tno - - Skip to the next uv data record. On write, this causes an end-of-record - mark to be written. On read, this causes data to be read up until the - next end-of-record mark. - - Input: - tno The uv data file handle. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int iostat; - UV *uv; - - uv = uvs[tno]; - if(uv->flags & (UVF_NEW|UVF_APPEND)){ - hwriteb_c(uv->item,var_eor_hdr,uv->offset,UV_HDR_SIZE,&iostat); - CHECK(iostat,(message,"Error writing end-of-record, in UVNEXT")); - uv->offset += UV_ALIGN; - } else { - uv->mark = uv->callno + 1; - uv->flags &= ~(UVF_UPDATED | UVF_COPY); - (void)uv_scan(uv,(VARIABLE *)NULL); - } -} -/************************************************************************/ -void uvrewind_c(int tno) -/**uvrewind -- Reset the uv data file to the start of the file. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvrewind(tno) - integer tno - - Rewind a uv file, readying it to be read from the begining again. - - Input: - tno The uv data file handle. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - VARIABLE *v; - VARHAND *vh; - int i; - - uv = uvs[tno]; - - uv->callno = uv->mark = 0; - for(i=0, v = uv->variable; i < uv->nvar; i++, v++) - v->callno = ( (v->flags & UVF_OVERRIDE) ? 1 : 0); - for(vh = uv->vhans; vh != NULL; vh = vh->fwd) vh->callno = 0; - uv->offset = 0; - uv->corr_flags.offset = 0; - uv->wcorr_flags.offset = 0; -} -/************************************************************************/ -void uvcopyvr_c(int tin,int tout) -/**uvcopyvr -- Copy variables from one uv file to another. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvcopyvr(tin,tout) - integer tin,tout - - - This copies those variables, in the input uv data set, which have - changed and which are marked as "copy" ('u' flag of a call to uvtrack). - - Inputs: - tin File handle of the input uv data set. - tout File handle of the output uv data set. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - VARIABLE *v; - int i; - - uv = uvs[tin]; - if(uv->flags & UVF_COPY) for(i=0, v=uv->variable; i < uv->nvar; i++,v++){ - if(v->callno >= uv->mark && (v->flags & UVF_COPY)) - uvputvr_c(tout,v->type,v->name,v->buf,VARLEN(v)); - } -} -/************************************************************************/ -int uvupdate_c(int tno) -/**uvupdate -- Check whether any "important" variables have changed. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - logical function uvupdate(tno) - integer tno - - This checks whether any ``important variables'' has been updated in the - last call to uvread or uvscan. Important variables are those flagged - with the 'u' flag in a call to uvtrack. - - Input: - tno File handle of the uv file to check. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - return(uvs[tno]->flags & UVF_UPDATED ? FORT_TRUE : FORT_FALSE); -} -/************************************************************************/ -void uvvarini_c(int tno,int *vhan) -/**uvvarini -- Retrieve a handle for the "uvVar" routines. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvvarini(tno,vhan) - - This routine allocates a handle for the uvVar routines. These routines - are used to keep track of changes to variables, and to copy them when - a change occurs. - - Input: - tno The handle of the uv data file. - Output: - vhan Handle of the list of variables. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int i; - VARHAND *vh; - UV *uv; - - uv = uvs[tno]; - -/* Locate a space handle slot. */ - - for(i=0; i < MAXVHANDS; i++)if(varhands[i] == NULL)break; - if(i == MAXVHANDS)BUG('f',"Ran out of variable handle slots, in UVVARINI"); - varhands[i] = vh = (VARHAND *)Malloc(sizeof(VARHAND)); - - vh->index = i; - vh->callno = 0; - vh->tno = tno; - vh->varhd = NULL; - vh->fwd = uv->vhans; - uv->vhans = vh; - *vhan = i+1; -} -/************************************************************************/ -void uvvarset_c(int vhan,Const char *var) -{ - VARHAND *vh; - VARIABLE *v; - VARPNT *vp; - - vh = varhands[vhan-1]; - v = uv_locvar(vh->tno,(char *)var); - if(v != NULL){ - vp = (VARPNT *)Malloc(sizeof(VARPNT)); - vp->v = v; - vp->fwd = vh->varhd; - vh->varhd = vp; - } -} -/************************************************************************/ -void uvvarcpy_c(int vhan,int tout) -{ - VARIABLE *v; - VARHAND *vh; - VARPNT *vp; - int callno; - - vh = varhands[vhan-1]; - callno = vh->callno; - vh->callno = uvs[vh->tno]->callno; - - for(vp = vh->varhd; vp != NULL; vp = vp->fwd){ - v = vp->v; - if(v->callno > callno) - uvputvr_c(tout,v->type,v->name,v->buf,VARLEN(v)); - } -} -/************************************************************************/ -int uvvarupd_c(int vhan) -{ - VARIABLE *v; - VARHAND *vh; - VARPNT *vp; - int callno; - - vh = varhands[vhan-1]; - callno = vh->callno; - vh->callno = uvs[vh->tno]->callno; - - for(vp = vh->varhd; vp != NULL; vp = vp->fwd){ - v = vp->v; - if(v->callno > callno) return(FORT_TRUE); - } - return(FORT_FALSE); -} -/************************************************************************/ -void uvrdvr_c(int tno,int type,Const char *var,char *data,const char *def,int n) -/**uvrdvr -- Return the value of a UV variable. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvrdvra(tno,varname,adata,adefault) - subroutine uvrdvri(tno,varname,idata,idefault) - subroutine uvrdvrr(tno,varname,rdata,rdefault) - subroutine uvrdvrd(tno,varname,ddata,ddefault) - subroutine uvrdvrc(tno,varname,cdata,cdefault) - integer tno - character varname*(*) - character adata*(*),adefault*(*) - integer idata, idefault - real rdata, rdefault - double precision ddata,ddefault - complex cdata,cdefault - - These routines get the first value of a variable. If the variable is - missing,the default value is returned. - - Input: - tno The handle of the uv data file. - varname The name of the variable to return. - default The default value. - Output: - data The returned value of the variable. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - VARIABLE *v; - int deflt,oktype; - - v = uv_locvar(tno,(char *)var); - oktype = TRUE; - deflt = (v == NULL); - if(!deflt) deflt = (v->buf == NULL) || (v->length == 0); - if(!deflt){ - switch(type){ - case H_BYTE: - oktype = (v->type == H_BYTE); - n = min(n-1,v->length); - if(oktype)memcpy(data,v->buf,n); - break; - case H_INT: - switch(v->type){ - case H_INT: *(int *)data = *(int *)(v->buf); break; - case H_REAL: *(int *)data = *(float *)(v->buf); break; - case H_DBLE: *(int *)data = *(double *)(v->buf); break; - default: oktype = FALSE; break; - } - break; - case H_REAL: - switch(v->type){ - case H_INT: *(float *)data = *(int *)(v->buf); break; - case H_REAL: *(float *)data = *(float *)(v->buf); break; - case H_DBLE: *(float *)data = *(double *)(v->buf); break; - default: oktype = FALSE; break; - } - break; - case H_DBLE: - switch(v->type){ - case H_INT: *(double *)data = *(int *)(v->buf); break; - case H_REAL: *(double *)data = *(float *)(v->buf); break; - case H_DBLE: *(double *)data = *(double *)(v->buf); break; - default: oktype = FALSE; break; - } - break; - case H_CMPLX: - oktype = (v->type == H_CMPLX); - if(oktype)memcpy(data,v->buf,internal_size[type]); - break; - default: - oktype = FALSE; - } - }else{ - if( type == H_BYTE ) n = min(n-1,(int)strlen(def)); - else n = internal_size[type]; - memcpy(data,def,n); - } - -/* Give a fatal error message if there is a type mismatch. */ - - if(!oktype) - ERROR('f',(message,"Type incompatiblity for variable %s, in UVRDVR",var)); - -/* Null terminate the data, if its a character string. */ - - if( type == H_BYTE ) *(data + n) = 0; -} -/************************************************************************/ -void uvgetvr_c(int tno,int type,Const char *var,char *data,int n) -/**uvgetvr -- Get the values of a uv variable. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvgetvra(tno,varname,adata) - subroutine uvgetvri(tno,varname,idata,n) - subroutine uvgetvrr(tno,varname,rdata,n) - subroutine uvgetvrd(tno,varname,ddata,n) - subroutine uvgetvrc(tno,varname,cdata,n) - integer tno,n - character varname*(*) - character adata*(*) - integer idata(n) - real rdata(n) - double precision ddata(n) - complex cdata(n) - - These routines return the current value of a uv variable. N gives the size - of elements in the return array. This MUST match with the actual number - of elements in the variable. An exception is for the character string - routine, where the size of the "adata" string must be strictly greater - than (not equal to!) the size of the string. - - Input: - tno The handle of the uv data file. - varname The name of the variable to return. - n The number of elements to return. This must agree with - the size of the variable! - Output: - data The returned values of the variable. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - VARIABLE *v; - int size; - - v = uv_locvar(tno,(char *)var); - if(v == NULL) - ERROR('f',(message,"Variable %s not found, in UVGETVR",var)); - size = external_size[type]; - if( type != v->type ) - ERROR('f',(message,"Variable %s has wrong type, in UVGETVR",var)); - if(v->buf == NULL) - ERROR('f',(message,"Variable %s currently has no value, in UVGETVR",var)); - if( (type == H_BYTE ? n < v->length + 1 : n*size != v->length) ) - ERROR('f',(message,"Buffer for variable %s has wrong size, in UVGETVR (%d != %d)", - var,n*size,v->length)); - -/* Copy the data. */ - - memcpy(data,v->buf,internal_size[type]*v->length/size); - -/* Null terminate the data, if its a character string. */ - - if( type == H_BYTE ) *(data + v->length) = 0; -} -/************************************************************************/ -void uvprobvr_c(int tno,Const char *var,char *type,int *length,int *updated) -/**uvprobvr -- Return information about a variable. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvprobvr(tno,varname,type,length,update) - integer tno,length - character varname*(*),type*1 - logical update - - This checks whether a particular variable exists. If it does, this - passes back the type and (current) length of the variable, and whether - it was updated on the last call to uvread or uvscan. - - Input: - tno The handle of the input uv data file. - varname The name of the variable to check. - Output: - type The type of the variable. If the variable does not - exist, this is blank. Otherwise it is one of 'a', 'r', - 'i', 'd' or 'c'. - length The number of elements in the uv variable. If this is not - known (which is true if the variable has never been read) - then this will be zero. - update This will be set .true. if this variable was updated - on the last call to uvread or uvscan. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - VARIABLE *v; - - uv = uvs[tno]; - v = uv_locvar(tno,(char *)var); - if(v == NULL) { - *type = ' '; - *length = 0; - *updated = FORT_FALSE; - } else { - *type = VARTYPE(v); - *length = VARLEN(v); - *updated = (v->callno >= uv->mark ? FORT_TRUE : FORT_FALSE); - } -} -/************************************************************************/ -void uvputvr_c(int tno,int type,Const char *var,Const char *data,int n) -/**uvputvr -- Write the value of a uv variable. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvputvra(tno,varname,adata) - subroutine uvputvri(tno,varname,idata,n) - subroutine uvputvrr(tno,varname,rdata,n) - subroutine uvputvrd(tno,varname,ddata,n) - subroutine uvputvrc(tno,varname,cdata,n) - integer tno,n - character varname*(*) - character adata*(*) - integer idata(n) - real rdata(n) - double precision ddata(n) - complex cdata(n) - - These routines write new values for a uv variable. N gives the number - of elements to write. - - Input: - tno The handle of the uv data file. - varname The name of the variable to write. - n The number of elements to write. - data The values of the variable. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - VARIABLE *v; - int size,iostat,changed,length,i; - char *in1,*in2; - - if(n <= 0){ - ERROR('w',(message,"Variable %s has zero or negative size, in UVPUTVR",var)); - return; - } - uv = uvs[tno]; - v = uv_mkvar(tno,(char *)var,type); - if(v->type != type) - ERROR('f',(message,"Variable %s has changed type, in UVPUTVR",var)); - size = external_size[type]; - -/* If the size of this variable has changed, write it out to the file. */ - - changed = (v->flags & UVF_NOCHECK); - if(v->length != size*n){ - changed = TRUE; - v->length = size * n; - var_size_hdr[0] = v->index; - hwriteb_c(uv->item,var_size_hdr,uv->offset,UV_HDR_SIZE,&iostat); - CHECK(iostat,(message,"Error writing variable-length header for %s, in UVPUTVR",var)); - hwritei_c(uv->item,&v->length,uv->offset+UV_HDR_SIZE,H_INT_SIZE,&iostat); - CHECK(iostat,(message,"Error writing variable-length for %s, in UVPUTVR",var)); - uv->offset += UV_ALIGN; - if( !(v->flags & UVF_NOCHECK) ) - v->buf = Realloc(v->buf,n*internal_size[type]); - } - -/* Check if this variable has really changed. */ - - if( !changed ) { - length = internal_size[type] * n; - in1 = v->buf; - in2 = (char *)data; - for( i = 0; i < length; i++ ) { - if(*in1++ != *in2++){ - changed = TRUE; - break; - } - } - } - -/* Write out the data itself. */ - - if( changed ) { - var_data_hdr[0] = v->index; - hwriteb_c(uv->item,var_data_hdr,uv->offset,UV_HDR_SIZE,&iostat); - CHECK(iostat,(message,"Error writing variable-value header for %s, in UVPUTVR",var)); - uv->offset += mroundup(UV_HDR_SIZE,size); - hwrite_c(uv->item,type,data,uv->offset,v->length,&iostat); - CHECK(iostat,(message,"Error writing variable-value for %s, in UVPUTVR",var)); - uv->offset = mroundup( uv->offset+v->length, UV_ALIGN); - if(v->callno++ > CHECK_THRESH) { - v->flags |= UVF_NOCHECK; - } else if(!(v->flags & UVF_NOCHECK)){ - length = internal_size[type] * n; - memcpy(v->buf,data,length); - } - } else { - v->callno = 0; - } -} -/************************************************************************/ -void uvtrack_c(int tno,Const char *name,Const char *switches) -/**uvtrack -- Set flags and switches associated with a uv variable. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvtrack(tno,varname,switches) - integer tno - character varname*(*),switches*(*) - - UVTRACK allows the programmer to set switches and flags associated with - a particular uv variable, to allow extra processing steps of that - variable. - - Input: - tno The handle of the input uv file. - varname The name of the variable of interest. - switches This is a character string, each character of which - causes a particular flag or switch to be turned on for - this particular variable. Valid values are: - 'u' Remember if this variable gets updated, and when - it gets updated, uvupdate returns .true. the next - time it is called. - 'c' Remember if this variable gets updated, and when - it gets updated, cause it to be copied during the - next call to uvcopyvr. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - VARIABLE *v; - - uv = uvs[tno]; - v = uv_locvar(tno,(char *)name); - if(v == NULL) return; - while(*switches)switch(*switches++){ - case 'u': v->flags |= UVF_UPDATED; - uv->flags |= UVF_UPDATED; break; - case 'c': v->flags |= UVF_COPY; - uv->flags |= UVF_COPY; break; - case ' ': break; - default: - ERROR('w',(message,"Unrecognised switch %c, in UVTRACK",*(switches-1))); - break; - } -} -/************************************************************************/ -int uvscan_c(int tno,Const char *var) -/**uvscan -- Scan a uv file until a variable changes. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - integer function uvscan(tno,varname) - integer tno - character varname*(*) - - Scan through a uv file until a particular variable changes. This always - reads to the end of the record (i.e. until all variables that change - simultaneously are read) after "varname" was encountered. - - Input: - tno The handle of the uv file to be scanned. - varname The variable to terminate the search. - - Output: - uvscan_c 0 on success, -1 on end-of-file. Standard error - number otherwise. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - VARIABLE *v; - -/* Locate the variable to scan on. */ - - uv = uvs[tno]; - if(*var){ - v = uv_locvar(tno,(char *)var); - if(v == NULL) ERROR('f',(message,"Variable %s not found, in UVSCAN",var)); - } else v = NULL; - uv->mark = uv->callno + 1; - uv->flags &= ~(UVF_UPDATED | UVF_COPY); - return( uv_scan(uv,v) ); -} -/************************************************************************/ -private int uv_scan(UV *uv, VARIABLE *vt) -/* - Scan the UV data stream until we have all the data we desire. - Inputs: - uv Structure describing uv file to scan through. - vt Structure describing variable to terminate scan when found. -------------------------------------------------------------------------*/ -{ - int iostat,intsize,extsize,terminate,found,changed,i,itemp; - off_t offset; - VARIABLE *v; - char s[UV_HDR_SIZE],*b; - - uv->callno++; - offset = uv->offset; - found = (vt == NULL); - terminate = FALSE; - while(!terminate){ - if(offset >= uv->max_offset) return -1; - hreadb_c(uv->item,s,offset,UV_HDR_SIZE,&iostat); - if(iostat == -1)return(-1); - else CHECK(iostat,(message,"Error reading a record header, while UV scanning")); - -/* Remember that this was updated, and set the "updated" flag if necessary. - Save the internal and external size of an element of this type. */ - - changed = FALSE; - if(*(s+2) != VAR_EOR){ - itemp = *s; - v = &uv->variable[itemp]; - intsize = internal_size[v->type]; - extsize = external_size[v->type]; - } - - switch(*(s+2)){ - -/* Process a specification of a variables length. Allocate buffers if needed. */ - case VAR_SIZE: - hreadi_c(uv->item,&v->flength,offset+UV_HDR_SIZE,H_INT_SIZE,&iostat); - CHECK(iostat,(message,"Error reading a variable-length for %s, while UV scanning",v->name)); - if(v->flength <= 0) - ERROR('f',(message,"Variable %s has length of %d, when scanning", - v->name,v->flength)); - if(v->flength % extsize) - ERROR('f',(message, - "Non-integral no. elements in variable %s, when scanning",v->name)); - if(!(v->flags & UVF_OVERRIDE) || v->type != H_BYTE){ - v->length = v->flength; - v->buf = Realloc( v->buf, (v->flength * intsize)/extsize ); - if(v->flags & UVF_OVERRIDE && v->flength > extsize) - for(i=1, b = v->buf + intsize; i < v->flength/extsize; i++,b += intsize) - memcpy(b,v->buf,intsize); - changed = TRUE; - } - offset += UV_ALIGN; - break; - -/* Process the data of a variable. If we want to keep track of the value - of this variable, read it. */ - case VAR_DATA: - offset += mroundup(UV_HDR_SIZE,extsize); - if(!(v->flags & UVF_OVERRIDE)){ - hread_c(uv->item,v->type,v->buf,offset,v->flength,&iostat); - CHECK(iostat,(message,"Error reading a variable value for %s, while UV scanning",v->name)); - changed = TRUE; - } - offset = mroundup(offset+v->flength,UV_ALIGN); - found |= (v == vt); - break; - -/* End of a block of synchronised data. */ - - case VAR_EOR: - terminate = found; - offset += UV_ALIGN; - break; - -/* Something is wrong. */ - - default: - ERROR('f',(message,"Unrecognised record code %d, when scanning",*(s+2))); - } - if(changed){ - v->callno = uv->callno; - uv->flags |= v->flags & (UVF_UPDATED | UVF_UPDATED_PLANET | - UVF_UPDATED_SKYFREQ | UVF_UPDATED_UVW | UVF_COPY); - } - } - uv->offset = offset; - return 0; -} -/************************************************************************/ -void uvwrite_c(int tno,Const double *preamble,Const float *data, - Const int *flags,int n) -/**uvwrite -- Write correlation data to a uv file. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvwrite(tno,preamble,data,flags,n) - integer tno,n - double precision preamble(*) - complex data(n) - logical flags(n) - - Write a visibility record to the data file. Please note uvwrite() - closes the record. Any wideband data should have been written with - uvwwrite() before this call. - Input: - tno Handle of the uv data set. - n Number of channels to be written. - preamble A double array of 4 elements giving u,v, time and - baseline number (in that order). - data A complex array of n elements containing - the correlation data. - flags Logical array of n elements. A true value for - a channel indicates good data. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - int i,nchan,i1,i2,nuvw,itemp; - float maxval,scale,*p,temp; - double *d,dtemp; - int *q; - char *counter,*status; - FLAGS *flags_info; - VARIABLE *v; - - uv = uvs[tno]; - -/* Initialise things if this is the first call to uvwrite. */ - - if(!(uv->flags & UVF_INIT)){ - uv->flags |= UVF_INIT; - if( uv->data_line.linetype == LINE_NONE) - uv->data_line.linetype = LINE_CHANNEL; - if( uv->data_line.linetype == LINE_CHANNEL){ - if( uv->corr == NULL ) - uv->corr = uv_mkvar(tno,"corr", - ( uv->minsize2 < 0 || n <= uv->minsize2 ? H_REAL : H_INT2) ); - uv->corr->flags |= UVF_NOCHECK; - if(uv->corr_flags.handle == NULL){ - status = (uv->corr_flags.offset == 0 ? "new" : "old"); - uv->corr_flags.handle = mkopen_c(uv->tno,"flags",status); - } - if( uv->corr_flags.handle == NULL) - BUG('f',"Failed to open the corr flags, in UVWRITE"); - } else if( uv->data_line.linetype == LINE_WIDE){ - if( uv->wcorr == NULL ) - uv->wcorr = uv_mkvar(tno,"wcorr", H_CMPLX); - uv->wcorr->flags |= UVF_NOCHECK; - if( uv->wcorr_flags.handle == NULL){ - status = (uv->wcorr_flags.offset == 0 ? "new" : "old"); - uv->wcorr_flags.handle = mkopen_c(uv->tno,"wflags",status); - } - if( uv->wcorr_flags.handle == NULL) - BUG('f',"Failed to open the wcorr flags, in UVWRITE"); - } else - BUG('f',"Unrecognised or unsupported linetype, in UVWRITE"); - -/* Create the preamble variables, if needed. */ - - if( uv->coord == NULL ){ - uv->coord = uv_mkvar(tno,"coord",H_DBLE); - uv->coord->flags |= UVF_NOCHECK; - if(uv->coord->buf == NULL){ - uv->coord->buf = Malloc(3*sizeof(double)); - d = (double *)(uv->coord->buf); - *d = *(preamble) + 1000; - } - } - - if( uv->time == NULL ){ - uv->time = uv_mkvar(tno,"time",H_DBLE); - uv->time->flags |= UVF_NOCHECK; - if(uv->time->buf == NULL){ - uv->time->buf = Malloc(sizeof(double)); - *(double *)(uv->time->buf) = *(preamble+2) + 1000; - } - } - - if( uv->bl == NULL ){ - uv->bl = uv_mkvar(tno,"baseline",H_REAL); - uv->bl->flags |= UVF_NOCHECK; - if(uv->bl->buf == NULL){ - uv->bl->buf = Malloc(sizeof(float)); - *(float *)(uv->bl->buf) = *(preamble + 3) + 1000; - } - } - } - -/* Get info on whether we are dealing with corr or wcorr data. */ - - if(uv->data_line.linetype == LINE_WIDE){ - counter = "nwide"; - v = uv->wcorr; - flags_info = &(uv->wcorr_flags); - } else { - counter = "nchan"; - v = uv->corr; - flags_info = &(uv->corr_flags); - } - -/* Update the size of the variable, if necessary. */ - - nchan = NUMCHAN(v); - if(n != nchan) uvputvri_c(tno,counter,&n,1); - -/* Write out the flagging info. */ - - if(uv->flags & UVF_RUNS) - mkwrite_c(flags_info->handle,MK_RUNS,(int *)(flags+1),flags_info->offset,n,*flags); - else - mkwrite_c(flags_info->handle,MK_FLAGS,(int *)flags,flags_info->offset,n,n); - flags_info->offset += n; - -/* Write out the correlation data. */ - - if(v->type == H_REAL){ - uvputvrr_c(tno,v->name,data,2*n); - } else if(v->type == H_CMPLX) { - uvputvrc_c(tno,v->name,data,n); - } else { - if(v->length != 2*n*H_INT2_SIZE) - v->buf = Realloc(v->buf,2*n*sizeof(int)); - maxval = 0; - p = (float *)data; - for(i=0; i < 2*n; i++){ - temp = *p++; - if(temp < 0)temp = -temp; - maxval = max(maxval,temp); - } - if(maxval == 0) maxval = 1; - scale = maxval / 32767; - uvputvrr_c(tno,"tscale",&scale,1); - scale = 32767 / maxval; - p = (float *)data; - q = (int *)v->buf; - for(i=0; i < 2*n; i++) *q++ = scale * *p++; - q = (int *)v->buf; - uvputvrj_c(tno,v->name,(int *)v->buf,2*n); - } - -/* Write out the preamble. */ - - d = (double *)(uv->coord->buf); - nuvw = (uv->flags & UVF_DOW ? 3 : 2); - if( *d != *preamble || *(d+1) != *(preamble+1) || - ( nuvw == 3 && *(d+2) != *(preamble+2) ) ){ - uvputvrd_c(tno,"coord",preamble,nuvw); - *d = *preamble; - *(d+1) = *(preamble+1); - if(nuvw == 3) *(d+2) = *(preamble+2); - } - preamble += nuvw; - - dtemp = *preamble++; - if( dtemp != *(double *)(uv->time->buf) ){ - uvputvrd_c(tno,"time",&dtemp,1); - *(double *)(uv->time->buf) = dtemp; - } - - temp = *preamble++; - if( temp != *(float *)(uv->bl->buf) ){ - itemp = temp; - uvbasant_c(itemp,&i1,&i2); - uv->flags |= ( i1 == i2 ? UVF_AUTO : UVF_CROSS); - uvputvrr_c(tno,"baseline",&temp,1); - *(float *)(uv->bl->buf) = temp; - } - -/* Write an end-of-record marker. */ - - uvnext_c(tno); -} -/************************************************************************/ -void uvwwrite_c(int tno,Const float *data,Const int *flags,int n) -/**uvwwrite -- Write wide-band correlation data to a uv file. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvwwrite(tno,data,flags,n) - integer tno,n - complex data(n) - logical flags(n) - - Write a wide-band visibility record to the data file. Make sure this - routine is called before uvwrite(), since that closes the record. - Input: - tno Handle of the uv data set. - n Number of channels to be written. - data A complex array of n elements containing - the correlation data. - flags Logical array of n elements. A true value for - a channel indicates good data. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - int nchan; - VARIABLE *v; - char *status; - - uv = uvs[tno]; - -/* Initialise things if needed. */ - - if( uv->wcorr == NULL ){ - uv->wcorr = uv_mkvar(tno,"wcorr", H_CMPLX); - uv->wcorr->flags |= UVF_NOCHECK; - } - if( uv->wcorr_flags.handle == NULL) { - status = (uv->wcorr_flags.offset == 0 ? "new" : "old" ); - uv->wcorr_flags.handle = mkopen_c(uv->tno,"wflags",status); - if(uv->wcorr_flags.handle == NULL) - BUG('f',"Failed to open the wcorr flags, in UVWWRITE"); - } - -/* Update the size of the variable, if necessary. */ - - v = uv->wcorr; - nchan = NUMCHAN(v); - if(n != nchan) uvputvri_c(tno,"nwide",&n,1); - -/* Write out the flagging info. */ - - if(uv->flags & UVF_RUNS) - mkwrite_c(uv->wcorr_flags.handle,MK_RUNS,(int *)(flags+1),uv->wcorr_flags.offset, - n,*flags); - else - mkwrite_c(uv->wcorr_flags.handle,MK_FLAGS,(int *) flags,uv->wcorr_flags.offset, - n,n); - uv->wcorr_flags.offset += n; - -/* Write out the correlation data. */ - - uvputvrc_c(tno,v->name,data,n); -} -/************************************************************************/ -void uvsela_c(int tno,Const char *object,Const char *string,int datasel) -/** uvsela -- Select or reject uv data, based on a character string */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvsela(tno,object,string,flag) - integer tno - character object*(*),string*(*) - logical flag - - This specifies the portion of the data to be selected by calls to - uvread. This sets the value of a character string to compare against. - - Input: - tno Handle of the uv data file. - object This can be one of "source". - string String value, used in the selection process. - flag If true, the data is selected. If false, the data is - discarded. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - SELECT *sel; - int discard; - - uv = uvs[tno]; - - discard = !datasel; - uv->flags &= ~UVF_INIT; - sel = uv->select; - -/* Either move to the last "SELECT" structure, or create the new structure. */ - - if(sel != NULL)while(sel->fwd != NULL) sel = sel->fwd; - else{ - sel = (SELECT *)Malloc(sizeof(SELECT)); - sel->amp.select = sel->selants = sel->win.select = FALSE; - sel->fwd = NULL; sel->opers = NULL; - sel->maxoper = sel->noper = 0; - sel->and = TRUE; - uv->select = sel; - } - -/* Selection by source or purpose. */ - - if(!strcmp(object,"source")){ - uv_addopers(sel,SEL_SRC,discard,0.0,0.0,string); - uv->need_src = TRUE; - - } else if (!strcmp(object,"purpose")) { - uv_addopers(sel,SEL_PURP,discard,0.0,0.0,string); - uv->need_purp = TRUE; - -/* Some unknown form of selection. */ - - } else { - ERROR('w',(message, - "Unrecognised selection \"%s\" ignored, in UVSELA",object)); - } -} -/************************************************************************/ -void uvselect_c(int tno,Const char *object,double p1,double p2,int datasel) -/**uvselect -- Select or reject uv data. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvselect(tno,object,p1,p2,flag) - integer tno - character object*(*) - double precision p1,p2 - logical flag - - This specifies the portion of the data to be selected by calls to - uvread. Normally data that are not selected, are not returned. - Exceptions are the "window" and "amplitude" objects, which cause the - corresponding visibilities to be flagged as bad, but returned anyway. - - Input: - tno Handle of the uv data file. - object This can be one of "time","antennae","visibility", - "uvrange","pointing","amplitude","window","or","dra", - "ddec","uvnrange","increment","ra","dec","and", "clear", - "on","polarization","shadow","auto","dazim","delev", - "purpose","seeing" (should be 28?) - p1,p2 Generally this is the range of values to select. For - "antennae", this is the two antennae pair to select. - For "antennae", a zero indicates "all antennae". - For "shadow", a zero indicates use "antdiam" variable. - For "on","window","polarization","increment","shadow" only - p1 is used. - For "and","or","clear","auto" p1 and p2 are ignored. - flag If true, the data is selected. If false, the data is - discarded. Ignored for "and","or","clear". */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - SELECT *sel; - int i,i1,i2,discard; - - uv = uvs[tno]; - - discard = !datasel; - uv->flags &= ~UVF_INIT; - - if(!strcmp(object,"clear")){ - uv_free_select(uv->select); - uv->select = NULL; - return; - } - -/* Ignore "and" and "or" objects if this is the first call. */ - - sel = uv->select; - if(sel == NULL && (!strcmp(object,"or") || !strcmp(object,"and"))) return; - -/* Either move to the last "SELECT" structure, or create the new structure. */ - - if(sel != NULL)while(sel->fwd != NULL) sel = sel->fwd; - else{ - sel = (SELECT *)Malloc(sizeof(SELECT)); - sel->amp.select = sel->selants = sel->win.select = FALSE; - sel->fwd = NULL; sel->opers = NULL; - sel->maxoper = sel->noper = 0; - sel->and = TRUE; - uv->select = sel; - } - -/* AND or OR operation. */ - - if(!strcmp(object,"or") || !strcmp(object,"and")){ - sel->fwd = (SELECT *)Malloc(sizeof(SELECT)); - sel = sel->fwd; - sel->amp.select = sel->selants = sel->win.select = FALSE; - sel->opers = NULL; - sel->fwd = NULL; - sel->maxoper = sel->noper = 0; - sel->and = (*object == 'a'); - -/* Selection by time. */ - - } else if(!strcmp(object,"time")){ - if(p1 >= p2) BUG('f',"Min time is greater than or equal to max time, in UVSELECT."); - uv_addopers(sel,SEL_TIME,discard,p1,p2,(char *)NULL); - -/* Selection by "on" parameter. */ - - } else if(!strcmp(object,"on")){ - uv_addopers(sel,SEL_ON,discard,p1,p1,(char *)NULL); - uv->need_on = TRUE; - -/* Selection by polarisation. */ - - } else if(!strcmp(object,"polarization")){ - uv_addopers(sel,SEL_POL,discard,p1,p1,(char *)NULL); - uv->need_pol = TRUE; - -/* Offset parameters, dazim and delev. */ - - } else if(!strcmp(object,"dazim")){ - if(p1 >= p2) BUG('f',"Min dazim is greater than or equal to max dazim, in UVSELECT."); - uv_addopers(sel,SEL_DAZIM,discard,p1,p2,(char *)NULL); - uv->need_dazim = TRUE; - } else if(!strcmp(object,"delev")){ - if(p1 >= p2) BUG('f',"Min delev is greater than or equal to max delev, in UVSELECT."); - uv_addopers(sel,SEL_DELEV,discard,p1,p2,(char *)NULL); - uv->need_delev = TRUE; - -/* Subfield parameters, dra and ddec. */ - - } else if(!strcmp(object,"dra")){ - if(p1 >= p2) BUG('f',"Min dra is greater than or equal to max dra, in UVSELECT."); - uv_addopers(sel,SEL_DRA,discard,p1,p2,(char *)NULL); - uv->need_dra = TRUE; - } else if(!strcmp(object,"ddec")){ - if(p1 >= p2) BUG('f',"Min ddec is greater than or equal to max ddec, in UVSELECT."); - uv_addopers(sel,SEL_DDEC,discard,p1,p2,(char *)NULL); - uv->need_ddec = TRUE; - -/* Phase centre parameters, ra and dec. */ - - } else if(!strcmp(object,"ra")){ - if(p1 >= p2) BUG('f',"Min ra is greater than or equal to max ra, in UVSELECT."); - uv_addopers(sel,SEL_RA,discard,p1,p2,(char *)NULL); - uv->need_ra = TRUE; - } else if(!strcmp(object,"dec")){ - if(p1 >= p2) BUG('f',"Min dec is greater than or equal to max dec, in UVSELECT."); - uv_addopers(sel,SEL_DEC,discard,p1,p2,(char *)NULL); - uv->need_dec = TRUE; - -/* Hour angle, LST and elevation. */ - - } else if(!strcmp(object,"ha")){ - if(p1 >= p2) BUG('f',"Min HA is greater than or equal to max HA, in UVSELECT."); - uv_addopers(sel,SEL_HA,discard,p1,p2,(char *)NULL); - uv->need_obsra = TRUE; - uv->need_lst = TRUE; - } else if(!strcmp(object,"lst")){ - uv_addopers(sel,SEL_LST,discard,p1,p2,(char *)NULL); - uv->need_lst = TRUE; - } else if(!strcmp(object,"elevation")){ - if(p1 >= p2) BUG('f',"Min elevation is greater than or equal to max elevation, in UVSELECT."); - uv_addopers(sel,SEL_ELEV,discard,p1,p2,(char *)NULL); - uv->need_elev = TRUE; - -/* Selection by uv baseline. */ - - } else if(!strcmp(object,"uvrange")){ - if(p1 >= p2) BUG('f',"Min uv is greater than or equal to max uv in UVSELECT"); - if(p1 < 0) BUG('f',"Min uv is negative, in UVSELECT"); - uv_addopers(sel,SEL_UV,discard,p1*p1,p2*p2,(char *)NULL); - uv->need_skyfreq = TRUE; - -/* Select by sky frequency of the first channel. */ - - } else if(!strcmp(object,"frequency")){ - if(p1 >= p2 || p1 <= 0) BUG('f', - "Illegal values for sky frequency selection, in UVSELECT"); - uv_addopers(sel,SEL_FREQ,discard,p1,p2,(char *)NULL); - uv->need_skyfreq = TRUE; - -/* Selection by uv baseline, given in nanosec. */ - - } else if(!strcmp(object,"uvnrange")){ - if(p1 >= p2) BUG('f',"Min uv is greater than or equal to max uv in UVSELECT"); - if(p1 < 0) BUG('f',"Min uv is negative, in UVSELECT"); - uv_addopers(sel,SEL_UVN,discard,p1*p1,p2*p2,(char *)NULL); - -/* Selection by pointing parameter. */ - - } else if(!strcmp(object,"pointing")){ - if(p1 >= p2) BUG('f',"Min pointing is greater than or equal to max pointing, in UVSELECT"); - if(p1 < 0) BUG('f',"Min pointing is negative, in UVSELECT"); - uv_addopers(sel,SEL_POINT,discard,p1,p2,(char *)NULL); - uv->need_point = TRUE; - -/* Selection by seeing parameter. */ - - } else if(!strcmp(object,"seeing")){ - if(p1 >= p2) BUG('f',"Min seeing is greater than or equal to max seeing, in UVSELECT"); - if(p1 < 0) BUG('f',"Min seeing is negative, in UVSELECT"); - uv_addopers(sel,SEL_SEEING,discard,p1,p2,(char *)NULL); - uv->need_seeing = TRUE; - -/* Selection by visibility number. */ - - } else if(!strcmp(object,"visibility")){ - if(p1 > p2) BUG('f',"Min visib is greater than max visib, in UVSELECT"); - if(p1 < 1) BUG('f',"Min visibility is negative, in UVSELECT"); - uv_addopers(sel,SEL_VIS,discard,p1,p2,(char *)NULL); - -/* Selection by visibility increment. */ - - } else if(!strcmp(object,"increment")){ - if(p1 < 1) BUG('f',"Bad increment selected, in UVSELECT."); - uv_addopers(sel,SEL_INC,discard,p1,0.0,(char *)NULL); - -/* Selection by shadowing. */ - - } else if(!strcmp(object,"shadow")){ - if(p1 != 0 || p2 < 0) BUG('f',"Bad antenna diameter, in UVSELECT."); - uv_addopers(sel,SEL_SHADOW,discard,p1,p2,(char *)NULL); - uv->need_uvw = TRUE; - -/* Pulsar bin selection. */ - - } else if(!strcmp(object,"bin")){ - if(p1 < 1 || p2 < p1) BUG('f',"Bad pulsar bin number, in UVSELECT."); - uv_addopers(sel,SEL_BIN,discard,p1,p2,(char *)NULL); - uv->need_bin = TRUE; - -/* Amplitude selection. */ - - } else if(!strcmp(object,"amplitude")){ - if(sel->amp.select) - BUG('f',"Cannot handle multiple amplitude selections in a clause"); - if(p1 < 0 || p2 <= p1) - BUG('f',"Bad amplitude range selected, in UVSELECT."); - sel->amp.discard = discard; - sel->amp.loval = p1; - sel->amp.hival = p2; - sel->amp.select = TRUE; - -/* Window selection. */ - - } else if(!strcmp(object,"window")){ - if(!sel->win.select) - for(i=0; i < MAXWIN; i++)sel->win.wins[i] = discard; - i = p1 + 0.5; - if(i < 1 || i > MAXWIN) BUG('f',"Too many windows"); - sel->win.wins[i-1] = !discard; - uv->need_win = TRUE; - - sel->win.select = TRUE; - sel->win.n = 0; - for(i=0; i < MAXWIN; i++) if(sel->win.wins[i]){ - if(sel->win.n == 0) sel->win.first = i; - sel->win.last = i; - sel->win.n++; - } - -/* Autocorrelation data. */ - - } else if(!strcmp(object,"auto")){ - if(!sel->selants){ - for(i=0; i < MAXANT*(MAXANT+1)/2; i++)sel->ants[i] = !discard; - sel->selants = TRUE; - } - for(i=0; i < MAXANT; i++)sel->ants[((i+1)*i)/2 + i] = discard; - -/* Antennae and baseline selection. */ - - } else if(!strcmp(object,"antennae")){ - if(!sel->selants){ - for(i=0; i < MAXANT*(MAXANT+1)/2; i++)sel->ants[i] = !discard; - sel->selants = TRUE; - } - i1 = max(p1, p2) + 0.5; - i2 = min(p1, p2) + 0.5; - if(i1 < 0 || i1 > MAXANT) ERROR('f',(message,"bad antennae %d",i1)); - if(i2 < 0 || i2 > MAXANT) ERROR('f',(message,"bad antennae %d",i2)); - if(i1 == 0){ - for(i=0; i < MAXANT*(MAXANT+1)/2; i++)sel->ants[i] = discard; - } else if(i2 == 0){ - for(i=1; i <= i1; i++) sel->ants[(i1*(i1-1))/2+i-1] = discard; - for(i=i1+1; i <= MAXANT; i++) sel->ants[(i*(i-1))/2+i1 -1] = discard; - } else { - sel->ants[(i1*(i1-1))/2+i2-1] = discard; - } - -/* Some unknown form of selection. */ - - } else { - ERROR('w',(message, - "Unrecognised selection \"%s\" ignored, in UVSELECT",object)); - } -} -/************************************************************************/ -private void uv_addopers(SELECT *sel,int type,int discard,double p1,double p2,char *ps) -{ - int n,i; - OPERS *oper; - -/* Allocate more space if needed. */ - - if(sel->noper == sel->maxoper){ - sel->maxoper = max(2*sel->maxoper,16); - sel->opers = (OPERS *)Realloc((char *)(sel->opers),sel->maxoper*sizeof(OPERS)); - } - -/* Shift the list down, to make space for the newcomer. */ - - n = sel->noper++; - for(i = n-1; i >= 0; i--){ - oper = sel->opers + i; - if( oper->type > type ) memcpy((char *)(oper+1),(char *)oper,sizeof(OPERS)); - else break; - } - -/* Squeeze the newcomer in. */ - - oper = sel->opers + i + 1; - oper->type = type; - oper->discard = discard; - oper->loval = p1; - oper->hival = p2; - oper->stval = NULL; - if(ps != NULL){ - oper->stval = (char *)Malloc(strlen(ps)+1); - strcpy(oper->stval,ps); - } -} -/************************************************************************/ -void uvset_c(int tno,Const char *object,Const char *type, - int n,double p1,double p2,double p3) -/**uvset -- Set up the uv linetype, and other massaging steps. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvset(tno,object,type,n,p1,p2,p3) - integer tno - character object*(*),type*(*) - integer n - real p1,p2,p3 - - Set up the way uvread behaves. This determines whether uvread returns - correlation channels, wide-band channels or velocity channels. This also - sets up whether u and v are returned in wavelengths or nanosec, and - what planet processing is performed. - - Input: - tno Handle of the uv data set. - object Name of the object that we are setting the type of. - type The type of data that the user wants returned. - n Some integer parameter. - p1,p2,p3 Some real parameters. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - - uv = uvs[tno]; - uv->flags &= ~UVF_INIT; - - if(!strcmp(object,"data")){ - uvset_linetype(&uv->data_line,type,n,p1,p2,p3); - } else if(!strcmp(object,"reference")) { - uvset_linetype(&uv->ref_line,type,1,p1,p2,p2); - } else if(!strcmp(object,"coord")) { - uvset_coord(uv,type); - } else if(!strcmp(object,"planet")) { - uvset_planet(uv,p1,p2,p3); - } else if(!strcmp(object,"preamble")) { - uvset_preamble(uv,type); - } else if(!strcmp(object,"selection")) { - uvset_selection(uv,type,n); - } else if(!strcmp(object,"gflag")) { - if(n < 1)bug_c('f',"Invalid value for average channel flagging tolerance"); - uv->gflag = n; - } else if(!strcmp(object,"flags")) { - if(!strcmp(type,"logical")) - uv->flags &= ~UVF_RUNS; - else if(!strcmp(type,"runs")) - uv->flags |= UVF_RUNS; - else { - ERROR('f',(message,"Unrecognised flags mode \'%s\', in UVSET",type)); - } - } else if(!strcmp(object,"minsize2")) { - uv->minsize2 = n; - } else if(!strcmp(object,"corr")) { - if(uv->corr != NULL)return; - if(!strcmp(type,"r")) - uv->corr = uv_mkvar(tno,"corr", H_REAL ); - else if(!strcmp(type,"c" )) - uv->corr = uv_mkvar(tno,"corr", H_CMPLX ); - else if(!strcmp(type,"j")) - uv->corr = uv_mkvar(tno,"corr", H_INT2 ); - else - ERROR('f',(message,"Unsupported correlation type %s, in UVSET",type)); - } else { - ERROR('w',(message,"Unrecognised object \"%s\" ignored, in UVSET.",object)); - } -} -/************************************************************************/ -private void uvset_preamble(UV *uv, char *type) -/* - Set the preamble that the user wants to use. -------------------------------------------------------------------------*/ -{ - char varnam[MAXNAM+1],*s; - int n,ok; - VARIABLE *v; - - uv->flags &= ~UVF_DOW; - if(uv->flags & UVF_NEW){ - uv->presize = 3; - if(!strcmp(type,"uvw/time/baseline"))uv->flags |= UVF_DOW; - else if(strcmp(type,"uv/time/baseline")){ - ERROR('f',(message,"Unsupported preamble \"%s\",in UVSET.",type));} - } else { - n = 0; - while(*type){ - if(n >= MAXPRE){ - ERROR('f',(message,"Too many parameters in preamble \"%s\".",type));} - -/* Get the variable name. */ - - s = varnam; - while(*type != 0 && *type != '/')*s++ = *type++; - if(*type == '/')type++; - *s = 0; - -/* Locate the appropriate variable. */ - - if(!strcmp(varnam,"uv")){ - v = uv->prevar[n] = uv_locvar(uv->tno,"coord"); - ok = (v != NULL && v->type == H_DBLE); - } else if(!strcmp(varnam,"uvw")){ - v = uv->prevar[n] = uv_locvar(uv->tno,"coord"); - uv->flags |= UVF_DOW; - ok = (v != NULL && v->type == H_DBLE); - } else { - v = uv->prevar[n] = uv_locvar(uv->tno,varnam); - ok = (v == NULL || v->type == H_INT || - v->type == H_REAL || v->type == H_DBLE); - } - if(!ok){ERROR('f',(message,"Invalid preamble \"%s\".",type));} - n++; - } - uv->presize = n; - } -} -/************************************************************************/ -private void uvset_selection(UV *uv, char *type, int n) -/* - Set the way the uvselect routine works. -------------------------------------------------------------------------*/ -{ - if(!strcmp(type,"amplitude")){ - uv->apply_amp = n > 0; - } else if(!strcmp(type,"window")){ - uv->apply_win = n > 0; - } else { - ERROR('w',(message,"Unrecognised type %s ignored, in UVSET(amplitude)",type)); - } -} -/************************************************************************/ -private void uvset_planet(UV *uv, double p1,double p2,double p3) -/* - Set the reference parameters for a planet, for scaling and rotation. -------------------------------------------------------------------------*/ -{ - uv->ref_plmaj = p1; - uv->ref_plmin = p2; - uv->ref_plangle = p3; - uv->need_planet = TRUE; -} -/************************************************************************/ -private void uvset_coord(UV *uv, char *type) -/* - Set the flags to do with the processing of uv coordinates. - - Input: - uv The UV data structure. - type A char string containing a type consisting of the following - string separated by dashes. - "wavelength" Return u,v in units of wavelengths. - "nanosec" Return u,v in units of nanosecs. -------------------------------------------------------------------------*/ -{ - if(!strcmp(type,"wavelength")){ uv->need_skyfreq = TRUE; - uv->flags |= UVF_WAVELENGTH; } - else if(!strcmp(type,"nanosec")){ uv->flags &= ~UVF_WAVELENGTH; } - else{ - ERROR('w',(message, - "Unrecognised coordinate type \"%s\" ignored, in UVSET",type)); - } -} -/************************************************************************/ -private void uvset_linetype(LINE_INFO *line, char *type, int n, - double start,double width,double step) -/* - Decode the line type. - Input: - line The LINE_INFO structure describing the line type. - type A char string being one of - "velocity" - "channel" - "wide" - n Number of channels. - start First channel to select. - width Width of channel. - step Increment between channels. -------------------------------------------------------------------------*/ -{ - if(!strcmp(type,"velocity") || !strcmp(type,"felocity")){ - if(width < 0) BUG('f',"Bad width in UVSET(line)"); - if(n < 0) BUG('f',"Bad number of channels, in UVSET(line)."); - if((width == 0 || n == 0) && (step != 0 || start != 0 || width != 0)) - BUG('f',"Invalid line parameters in UVSET(line)"); - line->linetype = (*type == 'v' ? LINE_VELOCITY : LINE_FELOCITY); - line->n = n; - line->fstart = start; line->fwidth = width; line->fstep = step; - } else if(!strcmp(type,"wide")) { - if(width < 1 || step < 1 || step < width) - BUG('f',"Bad width or step in UVSET(line)"); - if(start < 1 ) BUG('f',"Bad start value in UVSET(line)"); - if(n < 0) BUG('f',"Bad number of channels, in UVSET(line)."); - line->linetype = LINE_WIDE; - line->n = n; - line->start = start-1; line->width = width; line->step = step; - } else if(!strcmp(type,"channel")) { - if(width < 1 || step < 1) - BUG('f',"Bad width or step in UVSET(line)"); - if(start < 1 ) BUG('f',"Bad start value in UVSET(line)"); - if(n < 0) BUG('f',"Bad number of channels, in UVSET(line)."); - line->linetype = LINE_CHANNEL; - line->n = n; - line->start = start-1; line->width = width; line->step = step; - } else { - ERROR('w',(message, - "Unrecognised line type \"%s\" ignored, in UVSET",type)); - } -} - -/************************************************************************/ -int uvdim_c(tno) -int tno; -/**uvdim - Number of channels. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - integer function uvdim(tno) - integer tno - - Input: - tno Handle of the uv data set. - Output: - uvdim Number of channels. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - uv = uvs[tno]; - return(uv->actual_line.n); -} -/************************************************************************/ -void uvread_c(int tno,double *preamble,float *data,int *flags,int n,int *nread) -/**uvread -- Read in some uv correlation data. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvread(tno,preamble,data,flags,n,nread) - integer tno,n,nread - double precision preamble(*) - complex data(n) - logical flags(n) - - This reads a single visibility from the data file. This starts by scanning - the uv data stream until a correlation record is found. The correlations - are then converted to complex numbers if necessary, and returned to the - caller. Uvread also performs some massaging (see uvset) and selection - (see uvselect) steps. - - Input: - tno Handle of the uv data set. - n Max number of channels that can be read. - Output: - preamble A double array of elements giving things such as - u,v, time and baseline number. Setable using uvset. - data A real array of at least n complex elements (or 2n real - elements). This returns the correlation data. - flags Logical array of at least n elements. A true value for - a channel indicates good data. - nread Number of correlations returned. On end-of-file, zero - is returned. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - int more,nchan; - VARIABLE *v; - uv = uvs[tno]; - -/* Initialise everything if this is the first call to uvread. */ - - if(!(uv->flags & UVF_INIT)) uvread_defline(tno); - v = (uv->data_line.linetype == LINE_WIDE ? uv->wcorr : uv->corr); - uv->corr_flags.init = FALSE; - uv->wcorr_flags.init = FALSE; - -/* Scan the input data stream until we hit some correlation data. */ - - *nread = 0; - more = TRUE; - uv->mark = uv->callno + 1; - uv->flags &= ~(UVF_UPDATED | UVF_COPY); - -/* Scan the input data stream, and do any selection necessary. */ - - while(more){ - if(uv->maxvis > 0 && uv->callno > uv->maxvis) return; - do { - if(uv_scan(uv,(VARIABLE *)NULL) != 0)return; - if(!(uv->flags & UVF_INIT)) uvread_init(tno); - if(uv->corr != NULL)if(uv->corr->callno == uv->callno){ - nchan = NUMCHAN(uv->corr); - uv->corr_flags.offset += nchan; - } - if(uv->wcorr != NULL)if(uv->wcorr->callno == uv->callno){ - nchan = NUMCHAN(uv->wcorr); - uv->wcorr_flags.offset += nchan; - } - } while(v->callno < uv->callno); - -/* Perform uv selection. */ - - uv->amp = &noamp; - uv->win = &truewin; - if(uv->select != NULL) more = uvread_select(uv); - else more = FALSE; - } - -/* Update the planet parameters, if needed. */ - - if(uv->flags & UVF_UPDATED_PLANET) uvread_updated_planet(uv); - if(uv->flags & UVF_UPDATED_UVW) uvread_updated_uvw(uv); - -/* Apply linetype processing and planet scaling. */ - - *nread = uvread_line(uv,&(uv->data_line),data,n,flags,&(uv->actual_line)); - if(*nread == 0)return; - -/* Get preamble variables. */ - - uvread_preamble(uv,preamble); - -/* Divide by the reference line if there is one. */ - - if(uv->ref_line.linetype != LINE_NONE) uvread_reference(uv,data,flags,*nread); -} -/************************************************************************/ -private void uvread_preamble(UV *uv, double *preamble) -/* - Get the preamble associated with this record. -------------------------------------------------------------------------*/ -{ - VARIABLE *v; - double scale,uu,vv,ww,*coord; - int bl,i1,i2,i; - - - for(i=0; i < uv->presize; i++){ - v = uv->prevar[i]; - if(v == NULL){ - *preamble++ = 0; - } else if(v == uv->coord){ - coord = (double *)(uv->coord->buf); - uu = coord[0]; - vv = coord[1]; - if(uv->flags & UVF_REDO_UVW){ - bl = *((float *)(uv->bl->buf)) + 0.5; - uvbasant_c(bl,&i1,&i2); - i1--; i2--; - ww = uv->uvw->ww[i2] - uv->uvw->ww[i1]; - } else if(uv->flags & UVF_DOW) { - ww = (VARLEN(uv->coord) >= 3 ? coord[2] : 0.0); - } - scale = (uv->flags & UVF_WAVELENGTH ? uv_getskyfreq(uv,uv->win) : 1.0); - *preamble++ = scale * ( uv->pluu * uu + uv->pluv * vv ); - *preamble++ = scale * ( uv->plvu * uu + uv->plvv * vv ); - if(uv->flags & UVF_DOW ) *preamble++ = scale * ww; - } else if(v->type == H_DBLE){ - *preamble++ = *(double *)(v->buf); - } else if(v->type == H_REAL){ - *preamble++ = *(float *)(v->buf); - } else if(v->type == H_INT){ - *preamble++ = *(int *)(v->buf); - } - } -} -/************************************************************************/ -void uvwread_c(int tno,float *data,int *flags,int n,int *nread) -/**uvwread -- Read in the wideband uv correlation data. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvwread(tno,data,flags,n,nread) - integer tno,n,nread - complex data(n) - logical flags(n) - - This reads a single wideband visibility record from the data file. - This should generally be called after uvread. It performs no scanning - before returning the data. Thus it always returns any wideband data - (even if uvread has detected end-of-file). Although uvwread is independent - of the linetype set with uvset, it otherwise generally performs the - same massaging steps as uvread (e.g. data selection, amplitude flagging - and planet scaling). - - Input: - tno Handle of the uv data set. - n Max number of channels that can be read. - Output: - data A array of at least n complex elements (or 2n real - elements). This returns the correlation data. - flags Logical array of at least n elements. A true value for - a channel indicates good data. - nread Number of correlations returned. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv; - VARIABLE *v; - LINE_INFO line,dummy; - - uv = uvs[tno]; - -/* Determine the number of channels in the output, if none where given. */ - - if(uv->wcorr == NULL){ - if(uv_locvar(tno,"wcorr") != NULL){ - uv->wcorr = uv_checkvar(tno,"wcorr",H_CMPLX); - }else{ - *nread = 0; - return; - } - } - if(uv->wcorr_flags.handle == NULL && uv->wcorr_flags.exists){ - uv->wcorr_flags.handle = mkopen_c(uv->tno,"wflags","old"); - uv->wcorr_flags.exists = uv->wcorr_flags.handle != NULL; - if(!uv->wcorr_flags.exists) - BUG('w',"No flags found for wcorr -- assuming data are good"); - } - v = uv->wcorr; - - line.n = NUMCHAN(v); - line.linetype = LINE_WIDE; - line.width = line.step = 1; - line.start = 0; - - if(line.n > n) - BUG('f',"Callers buffer too small for wide data, in UVWREAD"); - -/* Apply linetype processing and planet scaling. */ - - *nread = uvread_line(uv,&line,data,n,flags,&dummy); - if(*nread == 0)return; - -/* Apply reference linetype, if there is one. */ - - if(uv->ref_line.linetype != LINE_NONE) uvread_reference(uv,data,flags,*nread); -} -/************************************************************************/ -private void uvread_reference(UV *uv, float *data, int *flags,int n) -/* - Divide the data by the reference line. If the reference is bad, then mark - all the data as bad. -------------------------------------------------------------------------*/ -{ - float refline[2],t,rp,im; - int refflag,nread; - int i; - LINE_INFO dummy; - - nread = uvread_line(uv,&(uv->ref_line),refline,1,&refflag,&dummy); - if(nread <= 0 || refflag == FORT_FALSE){ - for(i = 0; i < n; i++)*flags++ = FORT_FALSE; - } else { - t = 1.0/(refline[0]*refline[0] + refline[1]*refline[1]); - rp = t * refline[0]; - im = -t * refline[1]; - for(i = 0; i < n; i++){ - t = *data * im + *(data+1) * rp; - *data = *data * rp - *(data+1) * im; - data++; - *data++ = t; - } - } -} -/************************************************************************/ -private double uv_getskyfreq(UV *uv,WINDOW *win) -/* - This computes the sky frequency for a particular something. -------------------------------------------------------------------------*/ -{ - int i,i0,*nschan,start; - float vobs; - double *sdf,*sfreq,restfreq; - double temp; - -/* Check the validity of any window specification. */ - - if(win->first != 0){ - if(win->first >= VARLEN(uv->nschan)) - BUG('f',"Invalid window selection, in UVREAD(skyfreq)"); - } - - if(uv->data_line.linetype == LINE_VELOCITY){ - start = win->first; - if(uv->data_line.n == 0 || uv->data_line.fwidth == 0) - uvread_defvelline(uv,&(uv->data_line),win); - } else if(uv->data_line.linetype == LINE_FELOCITY){ - start = win->first; - uvread_defvelline(uv,&(uv->data_line),win); - } else { - start = uv->data_line.start; - if( win->first != 0 && uv->data_line.linetype == LINE_CHANNEL){ - nschan = (int *)uv->nschan->buf; - for(i=0; i < win->first; i++)start += *nschan++; - } - } - if(! (uv->flags & UVF_UPDATED_SKYFREQ) && start == uv->skyfreq_start) - return(uv->skyfreq); - -/* We have to recompute. First indicate that we have doe that already */ - - uv->skyfreq_start = start; - uv->flags &= ~UVF_UPDATED_SKYFREQ; - -/* CHANNEL linetype. */ - - if(uv->data_line.linetype == LINE_CHANNEL){ - nschan = (int *)uv->nschan->buf; - sfreq = (double *)uv->sfreq->buf; - sdf = (double *)uv->sdf->buf; - temp = 0; - while(start >= *nschan){ - start -= *nschan++; - sfreq++; sdf++; - } - for(i=0; i<uv->data_line.width; i++){ - if(start == *nschan){ - start = 0; - sfreq++; sdf++; nschan++; - } - temp += *sfreq + start * *sdf; - start++; - } - uv->skyfreq = temp / uv->data_line.width; - -/* VELOCITY linetype. */ - - } else if(uv->data_line.linetype == LINE_VELOCITY){ - restfreq = *((double *)uv->restfreq->buf + start); - vobs = *(float *)uv->veldop->buf - *(float *)uv->vsource->buf; - uv->skyfreq = restfreq*(1 - uv->data_line.fstart/CKMS)/(1 + vobs/CKMS); - -/* WIDE channels. */ - - } else if(uv->data_line.linetype == LINE_WIDE){ - temp = 0; - for(i=0, i0 = start; i<uv->data_line.width; i++, i0++){ - temp += *((float *)uv->wfreq->buf + i0); - } - uv->skyfreq = temp / uv->data_line.width; - } - return(uv->skyfreq); -} -/************************************************************************/ -private void uvread_updated_planet(UV *uv) -/* - This determines the planet rotation and scaling factors. - -------------------------------------------------------------------------*/ -{ - float plmaj,plmin,plangle; - double theta; - -/* Determine planet rotation and scaling factor. */ - - if(uv->ref_plmaj * uv->ref_plmin <= 0){ - uv->ref_plmaj = *(float *)uv->plmaj->buf; - uv->ref_plmin = *(float *)uv->plmin->buf; - uv->ref_plangle = *(float *)uv->plangle->buf; - } else { - plmaj = *(float *)uv->plmaj->buf; - plmin = *(float *)uv->plmin->buf; - plangle = *(float *)uv->plangle->buf; - if(plmaj > 0.0 && plmin > 0.0){ - uv->plscale = (uv->ref_plmaj * uv->ref_plmaj) / (plmaj * plmaj ) ; - theta = PI/180 * (plangle - uv->ref_plangle); - uv->pluu = cos(theta) * (plmaj / uv->ref_plmaj); - uv->pluv = -sin(theta) * (plmaj / uv->ref_plmaj); - uv->plvu = -uv->pluv; - uv->plvv = uv->pluu; - } else { - uv->plscale = 1; - uv->pluu = uv->plvv = 1; - uv->plvu = uv->pluv = 0; - } - } - uv->flags &= ~UVF_UPDATED_PLANET; -} -/************************************************************************/ -/* return 1 if record not selected, 0 if selected for output */ -private int uvread_select(UV *uv) -{ - int i,i1,i2,bl,pol,n,nants,inc,selectit,selprev,discard,binlo,binhi,on; - float *point,pointerr,dra,ddec,seeing; - double time,t0,uu,vv,uv2,uv2f,ra,dec,skyfreq,diameter; - double *dazim, *delev; - double lst,ha; - double *elev; - SELECT *sel; - OPERS *op; - WINDOW *win; - - selprev = TRUE; - - for(sel = uv->select; sel != NULL; sel = sel->fwd){ - if((!selprev && sel->and) || (selprev && !sel->and)) continue; - - discard = FALSE; - n = 0; - op = sel->opers; - -/* Apply antennae/baseline selection. */ - - if(sel->selants){ - bl = *((float *)(uv->bl->buf)) + 0.5; - uvbasant_c(bl,&i1,&i2); - if(i1 < 1 || i2 > MAXANT){ - ERROR('w',(message,"Discarded data with bad antenna numbers when selecting: (%d,%d) baseline number is %d\n",i1,i2,bl)); - discard = TRUE; - }else{ - discard = sel->ants[(i2*(i2-1))/2+i1-1]; - } - if(discard) goto endloop; - } - if( n >= sel->noper ) goto endloop; - -/* NOTE: The following tests must be in increasing size of the SEL_?? - parameters, because the list of selections has been sorted. Note that - the SEL_?? parameters are numbered in roughly increasing order of - the difficulty in computing them. */ - -/* Apply visibility number selection. */ - - if(op->type == SEL_VIS){ - discard = !op->discard; - while(n < sel->noper && op->type == SEL_VIS){ - if(op->loval <= uv->callno && uv->callno <= op->hival) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply time selection. */ - - if(op->type == SEL_TIME){ - time = *((double *)(uv->time->buf)); - i1 = time - 0.5; - t0 = time - i1 - 0.5; - discard = !op->discard; - while(n < sel->noper && op->type == SEL_TIME){ - if( (op->loval <= time && time <= op->hival) || - (op->loval <= t0 && t0 <= op->hival)) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply UV range selection, coordinates given in wavelengths. */ - - if(op->type == SEL_UVN){ - uu = *((double *)(uv->coord->buf)); - vv = *((double *)(uv->coord->buf) + 1); - uv2 = uu*uu + vv*vv; - discard = !op->discard; - while(n < sel->noper && op->type == SEL_UVN){ - if(op->loval <= uv2 && uv2 <= op->hival) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply pointing selection. */ - - if(op->type == SEL_POINT){ - bl = *((float *)(uv->bl->buf)) + 0.5; - uvbasant_c(bl,&i1,&i2); - discard = !op->discard; - point = (float *)(uv->axisrms->buf); - nants = VARLEN(uv->axisrms)/2; - if(i1 < 1 || i2 > nants){ - BUG('f',"Bad antenna numbers when checking pointing, in UVREAD(select)"); } - pointerr = max( *(point+2*i1-2),*(point+2*i1-1)); - pointerr = max( *(point+2*i2-2), pointerr); - pointerr = max( *(point+2*i2-1), pointerr); - - while(n < sel->noper && op->type == SEL_POINT){ - if(op->loval <= pointerr && pointerr <= op->hival) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply seeing monitor selection. */ - - if(op->type == SEL_SEEING){ - discard = !op->discard; - if(!uv->need_seeing) seeing = 0; - else seeing = *(float *)(uv->seeing->buf); - - while(n < sel->noper && op->type == SEL_SEEING){ - if(op->loval <= seeing && seeing <= op->hival) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - - - /* ==PJT== TODO: bleh, this could be in the wrong order .... */ - -/* Apply delta RA selection. */ - - if(op->type == SEL_DRA){ - discard = !op->discard; - if(!uv->need_dra) dra = 0; - else dra = *(float *)uv->dra->buf; - while(n < sel->noper && op->type == SEL_DRA){ - if(op->loval <= dra && dra <= op->hival) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply delta dec selection. */ - - if(op->type == SEL_DDEC){ - discard = !op->discard; - if(!uv->need_ddec) ddec = 0; - else ddec = *(float *)uv->ddec->buf; - while(n < sel->noper && op->type == SEL_DDEC){ - if(op->loval <= ddec && ddec <= op->hival) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply visibility number increment selection. */ - - if(op->type == SEL_INC){ - discard = !op->discard; - while(n < sel->noper && op->type == SEL_INC){ - inc = op->loval + 0.5; - if( (uv->callno - 1) % inc == 0) discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply RA selection. */ - - if(op->type == SEL_RA){ - discard = !op->discard; - if(uv->ra->type == H_REAL)ra = *(float *)(uv->ra->buf); - else ra = *(double *)(uv->ra->buf); - if(uv->need_dra){ - if(uv->dec->type == H_REAL)dec = *(float *)(uv->dec->buf); - else dec = *(double *)(uv->dec->buf); - if(uv->need_ddec)dec += *(float *)(uv->ddec->buf); - ra += *(float *)(uv->dra->buf) / cos(dec); - } - while(n < sel->noper && op->type == SEL_RA){ - if(op->loval <= ra && ra <= op->hival) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply DEC selection. */ - - if(op->type == SEL_DEC){ - if(uv->dec->type == H_REAL)dec = *(float *)(uv->dec->buf); - else dec = *(double *)(uv->dec->buf); - if(uv->need_ddec)dec += *(float *)(uv->ddec->buf); - discard = !op->discard; - while(n < sel->noper && op->type == SEL_DEC){ - if(op->loval <= dec && dec <= op->hival) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply polarization selection. */ - - if(op->type == SEL_POL){ - discard = !op->discard; - if(uv->need_pol) pol = *(int *)(uv->pol->buf); - else pol = 1; - while(n < sel->noper && op->type == SEL_POL){ - if(op->loval == pol) discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply selection based on the "on" parameter. */ - - if(op->type == SEL_ON){ - discard = !op->discard; - on = *(int *)(uv->on->buf); - while(n < sel->noper && op->type == SEL_ON){ - if(op->loval == on ) discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply source name selection. */ - - if(op->type == SEL_SRC){ - discard = !op->discard; - while(n < sel->noper && op->type == SEL_SRC){ - if(uvread_match(op->stval,uv->source->buf,uv->source->length)) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply UV range selection, where u-v is in wavelengths. */ - - if(op->type == SEL_UV){ - discard = !op->discard; - win = (sel->win.select ? &(sel->win) : uv->win); - skyfreq = uv_getskyfreq(uv,win); - uu = *((double *)(uv->coord->buf)); - vv = *((double *)(uv->coord->buf) + 1); - uv2f = (uu*uu + vv*vv) * skyfreq * skyfreq; - while(n < sel->noper && op->type == SEL_UV){ - if(op->loval <= uv2f && uv2f <= op->hival) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply sky frequency-based selection. */ - - if(op->type == SEL_FREQ){ - discard = !op->discard; - win = (sel->win.select ? &(sel->win) : uv->win); - skyfreq = uv_getskyfreq(uv,win); - while(n < sel->noper && op->type == SEL_FREQ){ - if(op->loval <= skyfreq && skyfreq <= op->hival) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply shadowing selection. */ - - if(op->type == SEL_SHADOW){ - discard = !op->discard; - while(n < sel->noper && op->type == SEL_SHADOW){ - diameter = op->hival; - if(diameter <= 0 && uv->antdiam != NULL) - diameter = *(float *)(uv->antdiam->buf); - if(diameter <= 0) - BUG('f',"No antenna diameter info available, in UVREAD(shadow_select)"); - if(uvread_shadowed(uv,diameter)) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply apply pulsar bin selection. */ - - if(op->type == SEL_BIN){ - discard = !op->discard; - while(n < sel->noper && op->type == SEL_BIN){ - binlo = op->loval + 0.5; - binhi = op->hival + 0.5; - if(binlo <= *(int *)(uv->bin->buf) && - *(int *)(uv->bin->buf) <= binhi ) discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply HA selection. */ - - if(op->type == SEL_HA){ - discard = !op->discard; - ha = *(double *)uv->lst->buf - *(double *)uv->obsra->buf; - /* ha can be -24..24 so needs to be back to -12..12 */ - if (ha < -PI) ha += 2*PI; - if (ha > PI) ha -= 2*PI; - while(n < sel->noper && op->type == SEL_HA){ - if(op->loval <= ha && ha <= op->hival) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply LST selection. */ - - if(op->type == SEL_LST){ - discard = !op->discard; - lst = *(double *)uv->lst->buf; - while(n < sel->noper && op->type == SEL_LST){ - if(op->loval < op->hival){ - if(op->loval <= lst && lst <= op->hival) - discard = op->discard; - }else{ - if(op->loval <= lst || lst <= op->hival) - discard = op->discard; - } - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply elevation selection. */ - - if(op->type == SEL_ELEV){ - bl = *((float *)(uv->bl->buf)) + 0.5; - uvbasant_c(bl,&i1,&i2); - discard = !op->discard; - elev = (double *)uv->elev->buf; - nants = VARLEN(uv->elev); - if(i1 < 1 || i2 > nants){ - BUG('f',"Bad antenna numbers when checking elevation, in UVREAD(select)"); } - - while(n < sel->noper && op->type == SEL_ELEV){ - if(op->loval <= elev[i1-1] && elev[i1-1] <= op->hival && - op->loval <= elev[i2-1] && elev[i2-1] <= op->hival) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply delta AZIM selection. */ - /* @todo: should only consider the current baseline */ - - if(op->type == SEL_DAZIM){ - discard = !op->discard; - if(uv->need_dazim) nants = uv->dazim->length / sizeof(double); - else nants=0; - - if(!uv->need_dazim) dazim = 0; - else dazim = (double *)uv->dazim->buf; - while(n < sel->noper && op->type == SEL_DAZIM){ - if (dazim==0) break; - for (i=0; i<nants; i++) { - if(op->loval <= dazim[i] && dazim[i] <= op->hival) { - discard = op->discard; - /* printf("ant %d: %g in-ranged %g %g \n",i+1,dazim[i],op->loval,op->hival); */ - } - } - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply delta ELEV selection. */ - /* @todo: should only consider the current baseline */ - - if(op->type == SEL_DELEV){ - discard = !op->discard; - if(uv->need_delev) nants = uv->delev->length / sizeof(double); - else nants=0; - - if(!uv->need_delev) delev = 0; - else delev = (double *)uv->delev->buf; - while(n < sel->noper && op->type == SEL_DELEV){ - if (delev==0) break; - for (i=0; i<nants; i++) { - if(op->loval <= delev[i] && delev[i] <= op->hival) - discard = op->discard; - } - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* Apply purpose PURP selection. */ - - if(op->type == SEL_PURP){ - discard = !op->discard; - while(n < sel->noper && op->type == SEL_PURP){ - if(uvread_matchp(op->stval,uv->purpose->buf,uv->purpose->length)) - discard = op->discard; - op++; n++; - } - if(discard || n >= sel->noper) goto endloop; - } - -/* We have processed this selection clause. Now determine whether the - overall selection criteria is to select or discard. Note that we cannot - get here if sel->and == TRUE and selprev == FALSE. */ - -endloop: - selectit = !discard; - if(selectit){ - if(uv->amp->select && sel->amp.select) - BUG('f',"Multiple amplitude selection clauses are active"); - if( sel->amp.select ) uv->amp = &(sel->amp); - if( uv->win->select && sel->win.select) - BUG('f',"Multiple window selection clauses are active"); - if( sel->win.select ) uv->win = &(sel->win); - } - selprev = selectit; - } /* for(sel) */ - -/* Check the validity of the window selection. */ - - if(selprev && uv->win->first != 0){ - if(uv->win->first >= VARLEN(uv->nschan)) - BUG('f',"Invalid window selection, in UVREAD(select)"); - } - return !selprev; -} -/************************************************************************/ -private int uvread_match(char *s1,char *s2, int length) -/* - This matches two (source) names in upper case. The first name may contain - wildcards (just asterisks, not the full blown UNIX regex). The second string - is not zero terminated. Used by select=source() - - Input: - s1 The first string. Can contain wildcards. Zero terminated. - s2 The second string. No wildcards. Not zero terminated. - length Length of the second string. - Output: - uvread_match True (1) if the two strings match. -------------------------------------------------------------------------*/ -{ - while(*s1 && length > 0){ - if(*s1 == '*'){ - s1++; - if(*s1 == 0)return 1; - while(length > 0){ - if(uvread_match(s1,s2,length)) return 1; - s2++; - length--; - } - return 0; - } else { - /* here we match ignoring case, before april 2006 - * we didn't do toupper() and ignored case - */ - if(toupper(*s1++) != toupper(*s2++)) return 0; - length--; - } - } - /* in order to match s=NAME* with s2=NAME we need to do one more test */ - if (*s1 == '*' && *(s1+1) == 0 && length == 0) - return 1; - - return *s1 == 0 && length == 0; -} - -private int uvread_matchp(char *s1,char *s2, int len2) -/* - This matches two purposes in upper case. No asterisks allowed. - The second string is not zero terminated. Used by select=purpose() - The first string should contain only 1 letter - - Input: - s1 The first string. No wildcards. Zero terminated. - s2 The second string. No wildcards. Not zero terminated. - len2 Length of the second string. - Output: - uvread_matchp True (1) if the two strings match. -------------------------------------------------------------------------*/ -{ - char *s; - - /* could do a strpbrk on 'BFGPRSO', the current CARMA allowed ones */ - /* i.e. if strpbrk(s1,"BFGPRSO") is NULL, BUG out ; but skip for now */ - - while(len2 > 0) { - for (s=s1; *s; s++) /* loop over s1 */ - if(toupper(*s) == toupper(*s2)) return 1; /* match */ - s2++; - len2--; - } - return 0; /* no match */ -} -/************************************************************************/ -int uvchkshadow_c (int tno, double diameter_meters) -/**uvchkshadow -- Check if the record comes from shadowed antennas */ -/*&pkgw */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - logical function uvchkshadow(tno,diameter_meters) - integer tno - double precision diameter_meters - - Returns whether the most recently-read UV record comes from a - baseline involving shadowed antennas. The antenna diameter used in - the shadow computation is passed in as an argument. The test - performed in this function is identical to the one performed when - using the "shadow()" selection keyword. There is no way to obtain - the results of the keyword test, however, without filtering out data - records. This function makes it possible to check whether a given - record was shadowed without filtering records. - - In order for this function to operate, you must apply a selection of - the form "shadow(1e9)" when reading the data. This is because UVW - recomputation must be performed as the data are read in, which is - only reliably triggered by applying a "shadow()" selection. The - extremely large argument ensures that no data are filtered out by - the selection. Invoking this function without applying the - necessary selection will result in a fatal bug being signaled. - - Another routine, SHADOWED, is provided with MIRIAD and provides - similar functionality. It is unclear, however, whether SHADOWED is - correct. It and the "shadow()" select keyword do their work - differently and yield different results. As of 2011 Feb 17, no tasks - in MIRIAD use SHADOWED. - - Input: - tno Handle of the uv data file. - diameter_meters The assumed antenna diameter in meters. - Output: - uvchkshadow Whether the last-read baseline was shadowed. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - UV *uv = uvs[tno]; - - if (!(uv->need_uvw)) - BUG('f', "Cannot check shadowing without setting up UVW recomputation" - " (try adding a shadow() selection)"); - - return uvread_shadowed (uv, diameter_meters); -} -/************************************************************************/ -private int uvread_shadowed(UV *uv,double diameter) -/* - This determines if a particular baseline is shadowed. - - Inputs: - uv The uv data structure. - diameter The dish diameter, in meters. -------------------------------------------------------------------------*/ -{ - int nants,i,j,i1,i2,i0,bl; - double u,v,w,limit; - UVW *uvw; - -/* Get the table of U,V,W coordinates. */ - - if(uv->flags & UVF_UPDATED_UVW) uvread_updated_uvw(uv); - uvw = uv->uvw; - -/* Convert the diameter to nanosec, and square it. */ - - limit = diameter / CKMS * 1e6; - limit *= limit; - -/* Set the number of antennae as the number of positions that we have. */ - - nants = uv->uvw->nants; - bl = *((float *)(uv->bl->buf)) + 0.5; - uvbasant_c(bl,&i1,&i2); - i1--;i2--; - if(i1 < 0 || i2 >= nants){ - BUG('f',"Bad antenna numbers when checking shadowing, in UVREAD(select)"); - } - - for(j=0; j < 2; j++){ - i0 = ( j == 0 ? i1 : i2); - if(i1 == i2 && j == 1)return(0); - for(i=0; i < nants; i++){ - if(i != i0){ - u = uvw->uu[i] - uvw->uu[i0]; - v = uvw->vv[i] - uvw->vv[i0]; - w = uvw->ww[i] - uvw->ww[i0]; - if(u*u + v*v <= limit && w >= 0) return(1); - } - } - } - return(0); -} -/************************************************************************/ -private void uvread_updated_uvw(UV *uv) -/* - Update the table of vectors used to computer u,v,w. -------------------------------------------------------------------------*/ -{ - UVW *uvw; - double ha,dec,sinha,cosha,sind,cosd; - double *posx,*posy,*posz,bx,by,bz,bxy,byx; - int i; - - if(uv->uvw == NULL)uv->uvw = (UVW *)Malloc(sizeof(UVW)); - uvw = uv->uvw; - uvw->nants = VARLEN(uv->antpos)/3; - if(uvw->nants > MAXANT ) bug_c('f',"Too many antennas in uvread_updated_uvw"); - -/* Get trig functions of the hour angle and the declination. */ - - ha = *(double *)(uv->lst->buf) - *(double *)(uv->obsra->buf); - dec = *(double *)(uv->obsdec->buf); - sinha = sin(ha); cosha = cos(ha); - sind = sin(dec); cosd = cos(dec); - - posx = (double *)(uv->antpos->buf); - posy = posx + uvw->nants; - posz = posy + uvw->nants; - for(i=0; i < uvw->nants; i++){ - bx = *posx++; - by = *posy++; - bz = *posz++; - bxy = bx*sinha + by*cosha; - byx = -bx*cosha + by*sinha; - uvw->uu[i] = bxy; - uvw->vv[i] = byx*sind + bz*cosd; - uvw->ww[i] = -byx*cosd + bz*sind; - } - -/* Remember that the table has been updated. */ - - uv->flags &= ~UVF_UPDATED_UVW; -} -/************************************************************************/ -private void uvread_defline(int tno) -/* - Initialise everything, ready to start reading. In particular, this - determines what variables are needed, makes sure they are there, and - makes sure they are being tracked. - - Inputs: - tno The handle of the file of interest. -------------------------------------------------------------------------*/ -{ - UV *uv; - - uv = uvs[tno]; - -/* If no line has been specified, return the default type -- i.e. - all the channels. */ - - uv->corr = uv_locvar(tno,"corr"); - uv->wcorr = uv_locvar(tno,"wcorr"); - - if(uv->data_line.linetype == LINE_NONE){ - if(uv->corr != NULL) - uv->data_line.linetype = LINE_CHANNEL; - else if(uv->wcorr != NULL) - uv->data_line.linetype = LINE_WIDE; - else - BUG('f',"UV file contains neither corr nor wcorr, in UVREAD(defline)"); - uv->data_line.start = 0; - uv->data_line.width = 1; - uv->data_line.step = 1; - uv->data_line.n = 0; - } -} -/************************************************************************/ -private void uvread_init(int tno) -/* - Initialise everything, ready to start reading. In particular, this - determines what variables are needed, makes sure they are there, and - makes sure they are being tracked. - - Inputs: - tno The handle of the file of interest. -------------------------------------------------------------------------*/ -{ - UV *uv; - SELECT *sel; - int n_win,n_or; - - uv = uvs[tno]; - uv->flags |= UVF_INIT; - -/* Open the flagging file, if it is needed. */ - - if(uv->data_line.linetype == LINE_CHANNEL || - uv->data_line.linetype == LINE_VELOCITY || - uv->data_line.linetype == LINE_FELOCITY || - uv->ref_line.linetype == LINE_CHANNEL || - uv->ref_line.linetype == LINE_VELOCITY || - uv->ref_line.linetype == LINE_FELOCITY ){ - if(uv->corr_flags.handle == NULL && uv->corr_flags.exists){ - uv->corr_flags.handle = mkopen_c(uv->tno,"flags","old"); - uv->corr_flags.exists = uv->corr_flags.handle != NULL; - if(!uv->corr_flags.exists) - BUG('w',"No flags found for corr -- assuming data are good"); - } - } - if(uv->data_line.linetype == LINE_WIDE || - uv->ref_line.linetype == LINE_WIDE ){ - if(uv->wcorr_flags.handle == NULL && uv->wcorr_flags.exists){ - uv->wcorr_flags.handle = mkopen_c(uv->tno,"wflags","old"); - uv->wcorr_flags.exists = uv->wcorr_flags.handle != NULL; - if(!uv->wcorr_flags.exists) - BUG('w',"No flags found for wcorr -- assuming data are good"); - } - } - -/* Make sure we have the info to get the preamble. */ - - uv->coord = uv_checkvar(tno,"coord",H_DBLE); - if( VARLEN(uv->coord) < ( uv->flags & UVF_DOW ? 3 : 2 ) ){ - if(uv_locvar(tno,"obsra") != NULL && uv_locvar(tno,"obsdec") != NULL && - uv_locvar(tno,"lst") != NULL && uv_locvar(tno,"antpos") != NULL){ - uv->flags |= UVF_REDO_UVW; - uv->need_uvw = TRUE; - } else { - BUG('w',"Unable to compute w coordinate -- setting this to zero"); - } - } - uv->time = uv_checkvar(tno,"time",H_DBLE); - uv->bl = uv_checkvar(tno,"baseline",H_REAL); - -/* Set up the default preamble if one has not already been set. */ - - if(uv->presize == 0){ - uv->presize = 3; - uv->prevar[0] = uv->coord; - uv->prevar[1] = uv->time; - uv->prevar[2] = uv->bl; - } - -/* Get info to decode correlation data. */ - - if( uv->data_line.linetype == LINE_CHANNEL || - uv->data_line.linetype == LINE_VELOCITY || - uv->data_line.linetype == LINE_FELOCITY || - uv->ref_line.linetype == LINE_CHANNEL || - uv->ref_line.linetype == LINE_VELOCITY || - uv->ref_line.linetype == LINE_FELOCITY ){ - if(uv->corr == NULL) - BUG('f',"Corr data missing, when channel linetype requested"); - if(uv->corr->type == H_INT2){ - uv->tscale = uv_checkvar(tno,"tscale",H_REAL); - } else if(uv->corr->type != H_REAL){ - BUG('f',"Bad data type for variable corr, in UVREAD."); - } // was there not a H_COMPLEX ?? - } - -/* Get variables needed for selection. */ - - if(uv->need_point) uv->axisrms = uv_checkvar(tno,"axisrms",H_REAL); - /* uv_checkvar can only handle existing variables */ -#if 1 - if(uv->need_seeing)uv->seeing = uv_checkvar(tno,"rmspath",H_REAL); /* CARMA */ -#else - if(uv->need_seeing)uv->seeing = uv_checkvar(tno,"smonrms",H_REAL); /* ATCA */ -#endif - if(uv->need_pol) uv->need_pol= uv_locvar(tno,"pol") != NULL; - if(uv->need_pol) uv->pol = uv_checkvar(tno,"pol",H_INT); - if(uv->need_on) uv->on = uv_checkvar(tno,"on",H_INT); - if(uv->need_purp) uv->purpose = uv_checkvar(tno,"purpose",H_BYTE); - if(uv->need_src) uv->source = uv_checkvar(tno,"source",H_BYTE); - if(uv->need_bin) uv->bin = uv_checkvar(tno,"bin",H_INT); - if(uv->need_lst) uv->lst = uv_checkvar(tno,"lst",H_DBLE); - if(uv->need_obsra) uv->obsra = uv_checkvar(tno,"obsra",H_DBLE); - if(uv->need_elev) uv->elev = uv_checkvar(tno,"antel",H_DBLE); - - if(uv->need_uvw){ - uv->obsra = uv_checkvar(tno,"obsra",H_DBLE); - uv->obsdec = uv_checkvar(tno,"obsdec",H_DBLE); - uv->lst = uv_checkvar(tno,"lst",H_DBLE); - uv->antpos = uv_checkvar(tno,"antpos",H_DBLE); - - uv->obsra->flags |= UVF_UPDATED_UVW; - uv->obsdec->flags |= UVF_UPDATED_UVW; - uv->lst->flags |= UVF_UPDATED_UVW; - uv->antpos->flags |= UVF_UPDATED_UVW; - - uv->flags |= UVF_UPDATED_UVW; - - if( ( uv->antdiam = uv_locvar(tno,"antdiam") ) != NULL) - uv->antdiam = uv_checkvar(tno,"antdiam",H_REAL); - } - -/* Get extra info needed for decoding frequencies and velocities of "corr" - data. */ - - if( uv->data_line.linetype == LINE_VELOCITY || - uv->ref_line.linetype == LINE_VELOCITY || - uv->data_line.linetype == LINE_FELOCITY || - uv->ref_line.linetype == LINE_FELOCITY){ - uv->nschan = uv_checkvar(tno,"nschan",H_INT); - uv->sfreq = uv_checkvar(tno,"sfreq",H_DBLE); - uv->sdf = uv_checkvar(tno,"sdf",H_DBLE); - uv->restfreq = uv_checkvar(tno,"restfreq",H_DBLE); - uv->veldop = uv_checkvar(tno,"veldop",H_REAL); - uv->vsource = uv_checkvar(tno,"vsource",H_REAL); - } - -/* Get info for decoding wide band stuff. */ - - if( uv->data_line.linetype == LINE_WIDE || - uv->ref_line.linetype == LINE_WIDE ){ - if(uv->wcorr == NULL) - BUG('f',"Wcorr missing, when wide linetype was requested"); - } - -/* Variables to determine the mapping from windows to channels. */ - - if(uv->need_win) - uv->nschan = uv_checkvar(tno,"nschan",H_INT); - -/* Variables needed to determine the sky frequency. */ - - if(uv->need_skyfreq){ - if(uv->data_line.linetype == LINE_WIDE){ - uv->wfreq = uv_checkvar(tno,"wfreq",H_REAL); - uv->wfreq->flags |= UVF_UPDATED_SKYFREQ; - - } else if(uv->data_line.linetype == LINE_CHANNEL){ - uv->nschan = uv_checkvar(tno,"nschan",H_INT); - uv->sfreq = uv_checkvar(tno,"sfreq",H_DBLE); - uv->sdf = uv_checkvar(tno,"sdf",H_DBLE); - uv->nschan->flags |= UVF_UPDATED_SKYFREQ; - uv->sfreq->flags |= UVF_UPDATED_SKYFREQ; - uv->sdf->flags |= UVF_UPDATED_SKYFREQ; - - } else if(uv->data_line.linetype == LINE_VELOCITY || - uv->data_line.linetype == LINE_FELOCITY ){ - uv->veldop->flags |= UVF_UPDATED_SKYFREQ; - uv->restfreq->flags |= UVF_UPDATED_SKYFREQ; - uv->vsource->flags |= UVF_UPDATED_SKYFREQ; - } - uv->flags |= UVF_UPDATED_SKYFREQ; - } - -/* RA,Dec, and delta ra and dec, possibly needed by the selection routines. - We can do without dra and ddec (we assume they are zero if they are missing), - but we cannot do without ra and dec if they are needed. */ - - if(uv->need_ra) { - uv->ra = uv_checkvar(tno,"ra",0); - if(uv->ra->type != H_REAL && uv->ra->type != H_DBLE) - BUG('f',"Variable ra has the wrong type, in UVREAD(ini)"); - uv->need_dra = uv_locvar(tno,"dra") != NULL; - if(uv->need_dra) uv->need_dec = TRUE; - } - - if(uv->need_dec) { - uv->dec = uv_checkvar(tno,"dec",0); - if(uv->dec->type != H_REAL && uv->dec->type != H_DBLE) - BUG('f',"Variable dec has the wrong type, in UVREAD(ini)"); - uv->need_ddec = TRUE; - } - - if(uv->need_dra) uv->need_dra = uv_locvar(tno,"dra") != NULL; - if(uv->need_dra) uv->dra = uv_checkvar(tno,"dra",H_REAL); - - if(uv->need_ddec) uv->need_ddec = uv_locvar(tno,"ddec") != NULL; - if(uv->need_ddec) uv->ddec = uv_checkvar(tno,"ddec",H_REAL); - - if(uv->need_dazim) uv->need_dazim = uv_locvar(tno,"dazim") != NULL; - if(uv->need_dazim) uv->dazim = uv_checkvar(tno,"dazim",H_DBLE); - - if(uv->need_delev) uv->need_delev = uv_locvar(tno,"delev") != NULL; - if(uv->need_delev) uv->delev = uv_checkvar(tno,"delev",H_DBLE); - - -/* Get info for performing planet corrections. If the data are missing, do - not perform planet corrections. */ - - if(uv->need_planet && uv_locvar(tno,"plmaj") != NULL){ - uv->plmaj = uv_checkvar(tno,"plmaj",H_REAL); - uv->plmaj->flags |= UVF_UPDATED_PLANET; - uv->plmin = uv_checkvar(tno,"plmin",H_REAL); - uv->plmin->flags |= UVF_UPDATED_PLANET; - uv->plangle = uv_checkvar(tno,"plangle",H_REAL); - uv->plangle->flags |= UVF_UPDATED_PLANET; - uv->flags |= UVF_UPDATED_PLANET; - } else uv->need_planet = FALSE; - -/* If line=channel and select=window, make sure our restrictions - are met. */ - - if(uv->data_line.linetype == LINE_CHANNEL && uv->apply_win){ - n_win = n_or = 0; - for(sel = uv->select; sel != NULL; sel = sel->fwd){ - if(!sel->and) n_or++; - if(sel->win.select){ - n_win++; - if(sel->win.last - sel->win.first >= sel->win.n) - BUG('f',"Unsupported window selection clause, in UVREAD(init)"); - } - } - if((n_or > 0 && n_win > 0) || (n_win > 1) ) - BUG('f',"Unsupported window selection clause, in UVREAD(init)"); - } - -/* Reset the variance calibration, if needed. NOTE: THIS DOES NOT - RELEASE THE variable handle -- which will not be released before - the file it descroyed. This result in a mild memory leak of sorts. */ - - if(uv->sigma2.table != NULL){ - free((char *)(uv->sigma2.table)); - uv->sigma2.table = NULL; - uv->sigma2.nants = 0; - } - -/* Determine the max visibility that the user is interested in. */ - - if(uv->select != NULL) uv->maxvis = uvread_maxvis(uv->select); - -} -/************************************************************************/ -private int uvread_maxvis(SELECT *sel) -/* - Determine the maximum visibility number that the caller wants. If this - cannot be determined, return 0. -------------------------------------------------------------------------*/ -{ - OPERS *op; - int temp,maxvis,ilo,ihi,n; - - maxvis = 0; - while(sel != NULL){ - temp = 0; - for(op = sel->opers,n = 0; n < sel->noper; n++, op++){ - if(op->type == SEL_VIS){ - ihi = op->hival + 0.5; ilo = op->loval + 0.5; - if(op->discard && temp == 0) return(0); - else if(op->discard && ihi >= temp) temp = min(temp, ilo); - else if(!op->discard) temp = max(temp, ihi); - } - } - if(temp <= 0) return(0); - maxvis = max(maxvis, temp); - sel = sel->fwd; - } - return(maxvis); -} -/************************************************************************/ -private VARIABLE *uv_checkvar(int tno,char *varname,int type) -/* - Make sure a particular variable is present, and make sure - we track it. Return the pointer to this variable. - - Input: - tno Handle of the uv data file. - varname The name of the variable we are interested in. - type The data type that the variable must be. -------------------------------------------------------------------------*/ -{ - VARIABLE *v; - - v = uv_locvar(tno,varname); - if(v == NULL) ERROR('f',(message, - "Variable %s is missing, in UVREAD",varname)); - else if(type != 0 && type != v->type)ERROR('f',(message, - "Variable %s has the wrong data type, in UVREAD",varname)); - else if(v->buf == NULL || v->length <= 0)ERROR('f',(message, - "Variable %s was not initialised before it was required, in UVREAD",varname)); - return(v); -} -/************************************************************************/ -private int uvread_line(UV *uv,LINE_INFO *line,float *data, - int nsize,int *flags,LINE_INFO *actual) -/* - Determine the desired line. - - Input: - uv The uv structure. - line Info about the line we are interested in. - nsize Size of the "data" array (in complex elements). - Output: - data The calculated line. - flags Flag info. - actual The actual line used. - uvread_line The number of values returned. -------------------------------------------------------------------------*/ -{ - int i,j,n,nspect; - VARIABLE *v; - WINDOW *win; - int *di; - int rei,imi,nc,start,width,step,*flagin,nchan,*nschan; - float scale,ref,imf,*df,*d; - FLAGS *flag_info; - int ggflag; - - ggflag = uv->gflag; - -/* Determine the relevant variable and flagging info, and get the flags. */ - - if(line->linetype == LINE_WIDE){ - v = uv->wcorr; - flag_info = &(uv->wcorr_flags); - } else { - v = uv->corr; - flag_info = &(uv->corr_flags); - } - nchan = NUMCHAN(v); - if(! flag_info->init ) uvread_flags(uv,v,flag_info,nchan); - -/* Handle velocity linetype. */ - - if(line->linetype == LINE_VELOCITY || line->linetype == LINE_FELOCITY){ - uvread_velocity(uv,line,data,flags,nsize,actual); - return(line->n); - } - -/* Determine the parameters which describe the line. */ - - start = line->start; - if(line->linetype == LINE_CHANNEL && uv->win->select && uv->apply_win){ - win = uv->win; - nspect = VARLEN(uv->nschan); - if(win->last >= nspect) - BUG('f',"Invalid window selection, in UVREAD(channel)"); - nschan = (int *)uv->nschan->buf; - nchan = 0; - for(i=0; i < win->first; i++) nchan += *nschan++; - start += nchan; - for(i=0; i < win->n; i++) nchan += *nschan++; - } - width = line->width; - step = line->step; - n = line->n; - if(n <= 0) n = (nchan - start) / step; - if(n <= 0 || start < 0 || start + step * (n-1) + width > nchan) { - printf("n=%d start=%d step=%d width=%d nchan=%d\n",n,start,step,width,nchan); - BUG('f',"Illegal channel range specified, in UVREAD"); - } - if(n > nsize) - BUG('f',"Callers buffer too small for channel data, in UVREAD"); - -/* Return the actual line used. */ - - actual->linetype = line->linetype; - actual->start = start; - actual->width = width; - actual->step = step; - actual->n = n; - -/* Miscellaneous initialisation. */ - - step -= width; - scale = uv->plscale; - flagin = flag_info->flags + start; - d = data; - -/* Handle the common case of just a straight copy of the correlation data. */ - - if(width == 1 && ( step == 0 || n == 1)){ - if(v->type == H_INT2){ - scale *= *(float *)uv->tscale->buf; - di = (int *)v->buf + 2*start; - for(i=0; i < 2*n; i++) *d++ = scale * *di++; - } else { - df = (float *)v->buf + 2*start; - if(scale != 1)for(i=0; i < 2*n; i++) *d++ = scale * *df++; - else memcpy((char *)d,(char *)df,2*sizeof(float)*n); - } - memcpy((char *)flags,(char *)flagin,sizeof(int)*n); - -/* Handle the case of averaged, scaled integers. */ - - } else if(v->type == H_INT2){ - di = (int *)(v->buf) + 2*start; - scale *= *(float *)uv->tscale->buf; - for(i=0; i<n; i++){ - rei = 0; imi = 0; nc = 0; - for(j=0; j<width; j++){ - if(*flagin++ == FORT_TRUE){ rei += *di++; imi += *di++; nc++; } - else di += 2; - } - if(nc > 0){ - *d++ = rei*scale/nc; *d++ = imi*scale/nc; *flags++ = ( nc >= ggflag ? FORT_TRUE : FORT_FALSE); - } else { - *d++ = 0; *d++ = 0; *flags++ = FORT_FALSE; - } - di += 2*step; flagin += step; - } - -/* Handle the case of averaged, reals. */ - - } else { - df = (float *)(v->buf) + 2*start; - for(i=0; i<n; i++){ - ref = 0; imf = 0; nc = 0; - for(j=0; j<width; j++){ - if(*flagin++ == FORT_TRUE){ ref += *df++; imf += *df++; nc++; } - else df += 2; - } - if(nc > 0){ - *d++ = scale*ref/nc; *d++ = scale*imf/nc; *flags++ = ( nc >= ggflag ? FORT_TRUE : FORT_FALSE); - } else { - *d++ = 0; *d++ = 0; *flags++ = FORT_FALSE; - } - df += 2*step; flagin += step; - } - } - return(n); -} -/************************************************************************/ -private void uvread_velocity(UV *uv,LINE_INFO *line,float *data, - int *flags,int nsize,LINE_INFO *actual) -/* - Calculate the velocity line type. - - Inputs: - uv Pointer to the uv data structure. - nsize Number of channels to return. - line Pointer to the structure defining the line type of interest. - Outputs: - data The velocity line type. - flags Flags indicating whether the data is good or not. -------------------------------------------------------------------------*/ -{ - float idv,idv2,odv2,dv2,scale,wt,v,vobs,temp; - double *sfreq,*sdf,*restfreq; - int nspect,first,last,fout,lout,i,j,n; - int *nschan,*flagin,*flagin1,*flagout,*wins,doint2; - float *wts,*dataout; - int *di,*di1; - float *df,*df1; - -/* Set the default line if needed. */ - - if(line->n == 0 || line->fstep == 0 || line->linetype == LINE_FELOCITY) - uvread_defvelline(uv,line,uv->win); - -/* A few simple checks. */ - - if(line->n <= 0) - BUG('f',"Bad number of channels, in UVREAD(velocity)"); - if(nsize < line->n) - BUG('f',"Callers buffer too small for velocity data, in UVREAD(velocity)"); - if(uv->corr->type != H_INT2 && uv->corr->type != H_REAL) - BUG('f',"Bad data type of corr data, in UVREAD(velocity)."); - doint2 = uv->corr->type == H_INT2; - if(line->wts == NULL) line->wts = (float *)Malloc(sizeof(float)*nsize); - -/* Return the actual line used. */ - - actual->linetype = line->linetype; - actual->n = line->n; - actual->fstart = line->fstart; - actual->fwidth = line->fwidth; - actual->fstep = line->fstep; - -/* Set the weights and data arrays to zero. */ - - nsize = line->n; - wins = uv->win->wins; - wts = line->wts; - dataout = data; - for(i=0; i<nsize; i++){ - *wts++ = 0.0; - *dataout++ = 0.0; *dataout++ = 0.0; - } - -/* Initialise lots of rubbish. */ - - nspect = VARLEN(uv->nschan); - if(nspect > MAXWIN) BUG('f',"Too many windows, in UVREAD(velocity)"); - - temp = line->fstep; - if(temp < 0) temp = -temp; - odv2 = 0.5 * line->fwidth/temp; - sfreq = (double *)uv->sfreq->buf; - sdf = (double *)uv->sdf->buf; - restfreq = (double *)uv->restfreq->buf; - vobs = *(float *)uv->veldop->buf - *(float *)uv->vsource->buf; - nschan = (int *)uv->nschan->buf; - scale = uv->plscale; - if(doint2)scale *= *(float *)uv->tscale->buf; - - wts = line->wts; - if(doint2)di1 = (int *)uv->corr->buf; - else df1 = (float *)uv->corr->buf; - dataout = data; - flagin1 = uv->corr_flags.flags; - -/* Now compute the velocity channels. The first loop moves over the windows, - determining which channels, in this window, contribute. The second loop - moves over these channels. The third loop moves over the output velocity - channels, accumulating the contribution of a particular input channel. */ - - for(n=0; n < nspect; n++){ - if(*wins++){ - v = (CKMS * (1 - *sfreq*(1+vobs/CKMS) / *restfreq) - line->fstart ) - / line->fstep; - idv = -CKMS * *sdf / (*restfreq * line->fstep); - idv2 = 0.5 * idv; - if(idv2 < 0) idv2 = - idv2; - dv2 = idv2 + odv2; - if(idv > 0){ - fout = ceil((-dv2-v)/idv); - lout = floor((nsize - 1 + dv2 - v)/idv); - } else if(idv < 0){ - fout = ceil((nsize - 1 + dv2 - v)/idv); - lout = floor((-dv2-v)/idv); - } else BUG('f',"File velocity increment is zero, in UVREAD(velocity)."); - if(fout < 0) fout = 0; - if(lout > *nschan-1) lout = *nschan - 1; - v += fout * idv; - if(doint2)di = di1 + fout + fout; - else df = df1 + fout + fout; - flagin = flagin1 + fout; - for(i=fout; i <= lout; i++){ - if(*flagin == FORT_TRUE){ - first = max(0, ceil (v-dv2)); - last = min(nsize-1,floor(v+dv2)); - if(doint2){ - for(j=first; j<=last; j++){ - wt = ( min(v + idv2, j + odv2) - max(v - idv2, j - odv2) ) / idv2; - *(dataout + j+j) += wt * *(di); - *(dataout + j+j + 1) += wt * *(di+1); - *(wts + j) += wt; - } - } else { - for(j=first; j<=last; j++){ - wt = ( min(v + idv2, j + odv2) - max(v - idv2, j - odv2) ) / idv2; - *(dataout + j+j) += wt * *(df); - *(dataout + j+j + 1) += wt * *(df+1); - *(wts + j) += wt; - } - } - } - v += idv; - flagin++; - if(doint2) di += 2; - else df += 2; - } - } - if(doint2) di1 += 2 * *nschan; - else df1 += 2 * *nschan; - flagin1 += *nschan; - nschan++; sfreq++; sdf++; restfreq++; - } - -/* Normalise and return. */ - - flagout = flags; - for(i=0; i<nsize; i++){ - if(*wts > 0.0){ - *dataout++ *= scale / *wts; - *dataout++ *= scale / *wts++; - *flagout++ = FORT_TRUE; - } else { - dataout += 2; - wts ++; - *flagout++ = FORT_FALSE; - } - } -} -/************************************************************************/ -private void uvread_defvelline(UV* uv,LINE_INFO *line,WINDOW *win) -/* - Determine a good, default, velocity line. - - Input: - win The window to use. - Input/Output: - line n,fstart,fwidth,fstep are set if needed. -------------------------------------------------------------------------*/ -{ - double f0,df,rfreq,fac; - int n; - float vobs; - -/* Get the frequency, etc, description of the first window. */ - - if(win->first != 0){ - if(win->first >= VARLEN(uv->nschan)) - BUG('f',"Invalid window selection, in UVREAD(skyfreq)"); - } - - vobs = *(float *)uv->veldop->buf - *(float *)uv->vsource->buf; - f0 = *((double *)uv->sfreq->buf + win->first); - df = *((double *)uv->sdf->buf + win->first); - n = *((int *)uv->nschan->buf + win->first); - rfreq = *((double *)uv->restfreq->buf + win->first); - if(rfreq <= 0)BUG('f',"Invalid rest frequency when setting default linetype"); - -/* Set the defaults. */ - - if(line->n == 0 || line->fwidth == 0){ - line->linetype = LINE_VELOCITY; - line->fwidth = -CKMS * df / rfreq; - line->fstep = MYABS(line->fwidth); - if(line->n == 0) line->n = n; - n = (n - line->n) / 2; - line->fstart = CKMS * ( 1 - (f0+n*df)*(1+vobs/CKMS)/rfreq ); - } - -/* Translate a felocity linetype into a velocity one, if needed. */ - - if(line->linetype == LINE_FELOCITY){ - line->linetype = LINE_VELOCITY; - fac = CKMS / (CKMS + line->fstart); - line->fstep *= fac * fac; - line->fwidth *= fac * fac; - line->fstart = fac * line->fstart; - } -} -/************************************************************************/ -private void uvread_flags(UV *uv,VARIABLE *v,FLAGS *flag_info,int nchan) -/* - Read in flagging information, and apply the amplitude flagging if needed. - -------------------------------------------------------------------------*/ -{ - int *di; - float *df,amp2,amplo2,amphi2,tscale,ii,rr; - int discard,i; - int *flags; - - flag_info->init = TRUE; - nchan = NUMCHAN(v); - -/* Allocate space and read the flags. */ - - if(flag_info->nflags < nchan){ - flag_info->nflags = nchan; - flag_info->flags = (int *)Realloc((char *)flag_info->flags, - sizeof(int) * flag_info->nflags); - } - flags = flag_info->flags; - if(flag_info->exists) - mkread_c(flag_info->handle,MK_FLAGS,flags, - flag_info->offset-nchan,nchan,nchan); - else for(i=0; i < nchan; i++) *flags++ = FORT_TRUE; - -/* Return if there is no amplitude flagging to do. */ - - if( !uv->amp->select || !uv->apply_amp ) return; - -/* Flag the appropriate channels. */ - - flags = flag_info->flags; - amplo2 = uv->amp->loval / uv->plscale; - amplo2 *= amplo2; - amphi2 = uv->amp->hival / uv->plscale; - amphi2 *= amphi2; - discard = uv->amp->discard; - -/* Case of real data. */ - - if(v->type == H_REAL || v->type == H_CMPLX){ - df = ((float *)(v->buf)); - for(i=0; i < nchan; i++){ - amp2 = *df * *df + *(df+1) * *(df+1); - if(amplo2 <= amp2 && amp2 <= amphi2) - *flags = ((*flags == FORT_TRUE && !discard) ? FORT_TRUE : FORT_FALSE); - else - *flags = ((*flags == FORT_TRUE && discard) ? FORT_TRUE : FORT_FALSE); - df += 2; flags++; - } - -/* Case of integer*2 data. */ - - } else if(v->type == H_INT2){ - di = ((int *)(v->buf)); - tscale = *((float *)(uv->tscale->buf)); - for(i=0; i < nchan; i++){ - rr = tscale * *di; - ii = tscale * *(di+1); - amp2 = rr * rr + ii * ii; - if(amplo2 <= amp2 && amp2 <= amphi2) - *flags = ((*flags == FORT_TRUE && !discard) ? FORT_TRUE : FORT_FALSE); - else - *flags = ((*flags == FORT_TRUE && discard) ? FORT_TRUE : FORT_FALSE); - di += 2; flags++; - } - } -} -/************************************************************************/ -void uvflgwr_c(int tno, Const int *flags) -/**uvflgwr -- Write uv flags after a read. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvflgwr(tno,flags) - integer tno - logical flags(*) - - This causes the flags associated with correlation data to be rewritten. - It is typically used by a flagging program to overwrite old flagging - information. It will typically be called soon after uvread (which is - used to get the old flags, and position the file), thus overwriting - the old flags. - - Input: - tno The handle of the input uv file. - flags Logical array of "nread" elements ("nread" as returned - by the last call to uvread). */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int nchan,width,step,n,i; - off_t offset; - UV *uv; - VARIABLE *v; - FLAGS *flags_info; - - uv = uvs[tno]; - - if(uv->actual_line.linetype == LINE_CHANNEL){ - v = uv->corr; - flags_info = &(uv->corr_flags); - } else { - v = uv->wcorr; - flags_info = &(uv->wcorr_flags); - } - - width = uv->actual_line.width; - step = uv->actual_line.step; - if(uv->actual_line.linetype == LINE_VELOCITY || - flags_info->handle == NULL || width != 1) - BUG('f',"Illegal request when trying to write to flagging file, in UVFLGWR"); - - nchan = NUMCHAN(v); - offset = flags_info->offset - nchan + uv->actual_line.start; - n = min(uv->actual_line.n,nchan); - if(step == 1){ - mkwrite_c(flags_info->handle,MK_FLAGS,(int *)flags,offset,n,n); - } else { - for(i = 0; i < n; i++){ - mkwrite_c(flags_info->handle,MK_FLAGS,(int *)flags,offset,1,1); - offset += step; - flags++; - } - } -} -/************************************************************************/ -void uvwflgwr_c(int tno,Const int *flags) -/**uvwflgwr -- Write uv flags after a read. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvwflgwr(tno,flags) - integer tno - logical flags(*) - - This rewrites the flags associated with the last call to uvwread. - It will typically be called soon after uvwread, thus overwriting - the old flags. - - Input: - tno The handle of the input uv file. - flags Logical array of "nread" elements ("nread" as returned - by the last call to uvwread). */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ - int nchan; - off_t offset; - UV *uv; - VARIABLE *v; - FLAGS *flags_info; - - uv = uvs[tno]; - - v = uv->wcorr; - if(v == NULL) - BUG('f',"The wcorr variable has not been initialised, in UVWFLGWR\n"); - flags_info = &(uv->wcorr_flags); - if(flags_info->handle == NULL) - BUG('f',"No flagging file exists, in UVWFLGWR\n"); - - nchan = NUMCHAN(v); - offset = flags_info->offset - nchan; - mkwrite_c(flags_info->handle,MK_FLAGS,(int *)flags,offset,nchan,nchan); -} -/************************************************************************/ -void uvinfo_c(int tno,Const char *object,double *data) -/**uvinfo -- Get information about the last data read with uvread. */ -/*&rjs */ -/*:uv-i/o */ -/*+ FORTRAN call sequence: - - subroutine uvinfo(tno,object,data) - integer tno - character object*(*) - double precision data(*) - - This returns extra information about the data read in the last call - to uvread. - - Input: - tno The handle of the uv file. - object Indicates what information is required. Currently - this can be - 'velocity' returns "nread" numbers, giving the velocity - (km/s) of each channel. - 'restfreq' returns "nread" numbers, giving the rest - frequency (GHz) of each channel. - 'bandwidth' returns "nread" numbers, giving the bandwidth - (GHz) of each channel. - 'visno' returns 1 number, which is the number of - visibilities read from this file. - 'frequency' returns "nread" numbers, giving the rest-frame - frequency (GHz) of each channel. - 'sfreq' returns "nread" numbers, giving the sky frequency - (GHz) of each channel. - 'amprange' returns 3 numbers. The first gives the amplitude - selection for this record, the next two give - the selection range. Possible values of data(1) are - -1 : Data outside the range [data(2),data(3)] - was rejected. - 0 : No amplitude selection. - +1 : Data inside the range [data(2),data(3)] - was rejected. - 'line' returns 6 numbers, giving the linetype. Possible - values of data(1) are 1, 2 or 3, corresponding to - 'channel', 'wide' and 'velocity'. - data(2) thru data(5) are n,start,width,step. - data(6) is the first window used. - 'variance' returns the variance (based on system temp) - of the first channel. If this cannot be determined - it returns 0. - Output: - data The actual information returned. */ -/*-- */ -/*----------------------------------------------------------------------*/ -{ -#define VELO 1 -#define FELO 2 -#define RFREQ 3 -#define BW 4 -#define FREQ 5 -#define SFREQ 6 - - UV *uv; - uv = uvs[tno]; - -/* Return the visibility number. */ - - if(!strcmp(object,"visno")){ - *data = uv->callno; - -/* Return the variance of the data in the first channel. */ - - } else if(!strcmp(object,"variance")){ - uvinfo_variance(uv,data); - -/* Return information about the amplitude selection. */ - - } else if(!strcmp(object,"amprange")){ - if( ! uv->amp->select ) *data = 0; - else{ - *data = (uv->amp->discard ? -1 : 1); - *(data+1) = uv->amp->loval; - *(data+2) = uv->amp->hival; - } - -/* Return linetype information. */ - - } else if(!strcmp(object,"line")){ - *data = uv->actual_line.linetype; - *(data+1) = uv->actual_line.n; - if(uv->actual_line.linetype == LINE_VELOCITY){ - *(data+2) = uv->actual_line.fstart; - *(data+3) = uv->actual_line.fwidth; - *(data+4) = uv->actual_line.fstep; - *(data+5) = uv->win->first + 1; - } else { - *(data+2) = uv->actual_line.start + 1; - *(data+3) = uv->actual_line.width; - *(data+4) = uv->actual_line.step; - *(data+5) = 0; - } - -/* Various bits and pieces of channel information. */ - - } else if(!strcmp(object,"velocity")) uvinfo_chan(uv,data,VELO); - else if(!strcmp(object,"felocity")) uvinfo_chan(uv,data,FELO); - else if(!strcmp(object,"restfreq")) uvinfo_chan(uv,data,RFREQ); - else if(!strcmp(object,"bandwidth")) uvinfo_chan(uv,data,BW); - else if(!strcmp(object,"frequency")) uvinfo_chan(uv,data,FREQ); - else if(!strcmp(object,"sfreq")) uvinfo_chan(uv,data,SFREQ); - else - ERROR('f',(message,"Unrecognised object %s, in UVINFO",object)); -} -/************************************************************************/ -private void uvinfo_variance(UV *uv,double *data) -/* - Determine the variance of the first channel of the last data read with - uvread. - - For raw polarisation parameters, - - variance = JyperK**2 * T1*T2/(2*Bandwidth*IntTime) - - where - - JyperK = 2*k/eta*A - - where A is the antenna area, eta is an efficiency (both surface efficiency - and correlator efficiency), and k is Boltzmans constant. - - For Stokes parameters, the variance returned is half the above variance, - as its assumed that two things have been summed to get the Stokes - parameter. -------------------------------------------------------------------------*/ -{ - double *restfreq,*tab; - float bw,inttime,jyperk,*syst,*t1,*t2,factor; - int i,j,bl,i1,i2,nants,nsyst,*nschan,start; - off_t offset; - LINE_INFO *line; - VARIABLE *tsys; - -/* Miscellaneous. */ - - line = &(uv->actual_line); - *data = 0; - -/* Have we initialised the table? If not, intialise as much as possible. */ - - if(!uv->sigma2.missing && uv->sigma2.table == NULL){ - if( (uv->pol = uv_locvar(uv->tno,"pol") ) != NULL) - (void)uv_checkvar(uv->tno,"pol",H_INT); - uvvarini_c(uv->tno,&(uv->sigma2.vhan)); - uvvarset_c(uv->sigma2.vhan,"nants"); - uvvarset_c(uv->sigma2.vhan,"inttime"); - uvvarset_c(uv->sigma2.vhan,"jyperk"); - uv->sigma2.missing = (uv_locvar(uv->tno,"inttime") == NULL) | - (uv_locvar(uv->tno,"jyperk") == NULL) | - (uv_locvar(uv->tno,"nants") == NULL); - if(line->linetype == LINE_CHANNEL){ - uvvarset_c(uv->sigma2.vhan,"systemp"); - uvvarset_c(uv->sigma2.vhan,"sdf"); - uvvarset_c(uv->sigma2.vhan,"nschan"); - uv->sigma2.missing |= (uv_locvar(uv->tno,"systemp") == NULL) | - (uv_locvar(uv->tno,"sdf") == NULL) | - (uv_locvar(uv->tno,"nschan") == NULL); - } else if(line->linetype == LINE_VELOCITY){ - uvvarset_c(uv->sigma2.vhan,"systemp"); - uvvarset_c(uv->sigma2.vhan,"restfreq"); - uv->sigma2.missing |= (uv_locvar(uv->tno,"systemp") == NULL) | - (uv_locvar(uv->tno,"restfreq")== NULL); - } else { - uvvarset_c(uv->sigma2.vhan,"wsystemp"); - uvvarset_c(uv->sigma2.vhan,"wwidth"); - uv->sigma2.missing |= (uv_locvar(uv->tno,"wsystemp") == NULL) | - (uv_locvar(uv->tno,"wwidth") == NULL); - } - } - -/* Return if we do not have enough info to determine the variance. */ - - if(uv->sigma2.missing) return; - -/* Is the table of variances out of date? If so recompute it. */ - - if(uvvarupd_c(uv->sigma2.vhan) == FORT_TRUE){ - nants = *(int *)(uv_checkvar(uv->tno,"nants",H_INT)->buf); - inttime = *(float *)(uv_checkvar(uv->tno,"inttime",H_REAL)->buf); - jyperk = *(float *)(uv_checkvar(uv->tno,"jyperk",H_REAL)->buf); - if(line->linetype == LINE_CHANNEL){ - nschan = (int *)(uv_checkvar(uv->tno,"nschan",H_INT)->buf); - start = line->start; - offset = 0; - while(start >= *nschan){ - start -= *nschan++; - offset++; - } - bw = *((double *)(uv_checkvar(uv->tno,"sdf",H_DBLE)->buf) + offset) - * line->width; - tsys = uv_checkvar(uv->tno,"systemp",H_REAL); - } else if(line->linetype == LINE_WIDE){ - offset = line->start; - bw = *((float *)(uv_checkvar(uv->tno,"wwidth",H_REAL)->buf) + offset) - * line->width; - tsys = uv_checkvar(uv->tno,"wsystemp",H_REAL); - } else if(line->linetype == LINE_VELOCITY){ - offset = uv->win->first; - restfreq = (double *)(uv_checkvar(uv->tno,"restfreq",H_DBLE)->buf) + - offset; - bw = *restfreq * line->fwidth / CKMS; - tsys = uv_checkvar(uv->tno,"systemp",H_REAL); - } - if(bw < 0) bw = - bw; - -/* We have everything we ever wanted: jyperk,inttime,bw and Tsys. Compute - variance. */ - - if(nants > uv->sigma2.nants){ - if(uv->sigma2.table != NULL)free((char *)(uv->sigma2.table)); - uv->sigma2.table = (double *)Malloc(sizeof(double)*(nants*(nants+1))/2); - } - - uv->sigma2.nants = nants; - nsyst = VARLEN(tsys); - syst = (float *)(tsys->buf); - factor = jyperk*jyperk/inttime/(2.0e9*bw) * uv->plscale; - tab = uv->sigma2.table; - if(nsyst < nants){ - factor *= *syst * *syst; - for(i=0; i < (nants*(nants+1))/2; i++)*tab++ = factor; - } else { - if(nsyst >= nants*(offset+1)) syst += nants*offset; - t2 = syst; - for(j=0; j < nants; j++){ - t1 = syst; - for(i=0; i <= j; i++){ - *tab++ = factor * *t1++ * *t2; - } - t2++; - } - } - } - -/* All is up to date and OK. Return the result. */ - - bl = *((float *)(uv->bl->buf)) + 0.5; - uvbasant_c(bl,&i1,&i2); - if(i1 < 1 || i2 > uv->sigma2.nants)return; - bl = (i2*(i2-1))/2+i1-1; - *data = uv->sigma2.table[bl]; - -/* If its a Stokes parameter, multiply the variance by one half. */ - - if(uv->pol != NULL && *((int*)(uv->pol->buf)) > 0) *data *= 0.5; -} -/************************************************************************/ -private void uvinfo_chan(UV *uv,double *data,int mode) -/* -------------------------------------------------------------------------*/ -{ - LINE_INFO *line; - int n,i,j,step; - off_t offset; - double temp,fdash; - float *wfreq,*wwide,vobs; - int *nschan; - double *sdf,*sfreq,*restfreq; - -/* Get the velocity of the "channel" line type. */ - - line = &(uv->actual_line); - n = line->n; - - if(line->linetype == LINE_CHANNEL){ - vobs = *(float *)(uv_checkvar(uv->tno,"veldop",H_REAL)->buf) - - *(float *)(uv_checkvar(uv->tno,"vsource",H_REAL)->buf); - nschan = (int *)(uv_checkvar(uv->tno,"nschan",H_INT)->buf); - sfreq = (double *)(uv_checkvar(uv->tno,"sfreq",H_DBLE)->buf); - sdf = (double *)(uv_checkvar(uv->tno,"sdf",H_DBLE)->buf); - restfreq = (double *)(uv_checkvar(uv->tno,"restfreq",H_DBLE)->buf); - step = line->step - line->width; - offset = line->start; - for(j=0; j < n; j++){ - temp = 0; - while(offset >= *nschan){ - offset -= *nschan++; - sfreq++; sdf++; restfreq++; - } - for(i=0; i < line->width; i++){ - if(offset == *nschan){ - offset = 0; - sfreq++; sdf++; nschan++; restfreq++; - } - if(mode == VELO){ - if(*restfreq <= 0)BUG('f',"Cannot determine velocity as rest frequency is 0"); - fdash = (*sfreq + offset * *sdf)*(1 + vobs/CKMS); - temp += CKMS * ( 1 - fdash / *restfreq ); - }else if(mode == FELO){ - if(*restfreq <= 0)BUG('f',"Cannot determine velocity as rest frequency is 0"); - fdash = (*sfreq + offset * *sdf)*(1 + vobs/CKMS); - temp += CKMS * ( *restfreq / fdash - 1 ); - }else if(mode == RFREQ) temp += *restfreq; - else if(mode == BW) temp += (*sdf > 0 ? *sdf : - *sdf); - else if(mode == FREQ) - temp += (*sfreq + offset * *sdf)*(1 + vobs/CKMS); - else if(mode == SFREQ) - temp += *sfreq + offset * *sdf; - offset++; - } - if(mode != BW) *data++ = temp / line->width; - else *data++ = temp; - offset += step; - } - -/* Wide channel information. Getting the velocity of this does not make a - great deal of sense. Assume the rest frequency is the same as the sky - frequency of the first wide channel. */ - - } else if(line->linetype == LINE_WIDE){ - if(mode == RFREQ || mode == VELO || mode == FELO){ - BUG('f',"Invalid object for wide linetype, in UVINFO\n"); - } else if(mode == FREQ || mode == SFREQ){ - step = line->step - line->width; - wfreq = (float *)(uv_checkvar(uv->tno,"wfreq",H_REAL)->buf); - wfreq += line->start; - for(j=0; j < n; j++){ - temp = 0; - for(i=0; i < line->width; i++) temp += *wfreq++; - *data++ = temp/line->width; - wfreq += step; - } - } else if(mode == BW){ - step = line->step - line->width; - wwide = (float *)(uv_checkvar(uv->tno,"wwidth",H_REAL)->buf); - wwide += line->start; - for(j=0; j < n; j++){ - temp = 0; - for(i=0; i < line->width; i++) temp += *wwide++; - *data++ = temp; - wwide += step; - } - } - -/* Velocity channel information. This is pretty trivial. */ - - } else if(line->linetype == LINE_VELOCITY){ - - if(mode == VELO){ - for(i=0; i<n; i++) *data++ = line->fstart + i * line->fstep; - } else if(mode == FELO){ - vobs = *(float *)(uv_checkvar(uv->tno,"veldop",H_REAL)->buf) - - *(float *)(uv_checkvar(uv->tno,"vsource",H_REAL)->buf); - for(i=0; i<n; i++){ - temp = line->fstart + i * line->fstep; - *data++ = CKMS*temp / (CKMS-temp); - } - } else if(mode == RFREQ){ - restfreq = (double *)(uv_checkvar(uv->tno,"restfreq",H_DBLE)->buf) + - uv->win->first; - for(i=0; i<n; i++) *data++ = *restfreq; - } else if(mode == FREQ){ - restfreq = (double *)(uv_checkvar(uv->tno,"restfreq",H_DBLE)->buf) + - uv->win->first; - for(i=0; i<n; i++) - *data++ = *restfreq * (1 - (line->fstart + i *line->fstep)/CKMS); - } else if(mode == SFREQ){ - restfreq = (double *)(uv_checkvar(uv->tno,"restfreq",H_DBLE)->buf) + - uv->win->first; - vobs = *(float *)(uv_checkvar(uv->tno,"veldop",H_REAL)->buf) - - *(float *)(uv_checkvar(uv->tno,"vsource",H_REAL)->buf); - for(i=0; i<n; i++) - *data++ = *restfreq * (1 - (line->fstart + i *line->fstep)/CKMS)/ - (1+vobs/CKMS); - } else if(mode == BW){ - restfreq = (double *)(uv_checkvar(uv->tno,"restfreq",H_DBLE)->buf) + - uv->win->first; - temp = *restfreq * line->fwidth / CKMS; - if(temp < 0) temp = - temp; - for(i=0; i<n; i++) *data++ = temp; - } - } -} -/************************************************************************/ -/* if one EVER decides to change this decoding horror, also make sure - * the following routines are looked after: - * - * basant.for: subroutine basant() , function antbas() - * - * see also maxdim.h and maxdimc.h - * - * Notes from the 32/64 bit times: - * MAXIANT should be 2048, and is the largest value - * to accomodate baseline encoding in double's - * 65536 is really 256*256 - * - * The rationale for the value of MAXIANT and this encoding scheme - * in general are documented thoroughly in BASANT. - */ - -enum { MAXIANT = 2048 }; - -private void uvbasant_c(int baseline,int *i1,int *i2) -{ - int mant; - *i2 = baseline; - if(*i2 > 65536){ - *i2 -= 65536; - mant = MAXIANT; - }else{ - mant = 256; - } - *i1= *i2 / mant; - *i2 %= mant; -} - Index: casacore-3.5.0/mirlib/xyio.c =================================================================== --- casacore-3.5.0.orig/mirlib/xyio.c +++ /dev/null @@ -1,494 +0,0 @@ -/************************************************************************/ -/* */ -/* Routines to access and manipulate an image. */ -/* */ -/* History: */ -/* rjs Dark-ages Original version. */ -/* rjs 6nov89 Neatly handle the case of a non-existent mask file.*/ -/* rjs 7feb90 Added comments, ready to be stripped out by "doc". */ -/* rjs 13jul92 Improved error messages in xyopen, to appease nebk.*/ -/* rjs 23feb93 Include maxdimc.h, which contains maxnax. */ -/* rjs 6nov94 Change item handle to an integer. */ -/* rjs 27feb96 Added xyflush. */ -/* rjs 15mar96 Inlcude an exrta include file. */ -/* pjt 17jun02 MIR4 prototypes, > 2GB patches */ -/* rjs/pjt 3jun03 "append" mode in xyopen - long live non-CVS devel. */ -/* pkgw 09may12 Prevent XYOPEN callers from causing it to scribble */ -/* over our image data structures (and potentially */ -/* beyond). */ -/*----------------------------------------------------------------------*/ - -#if defined(HAVE_CONFIG_H) && HAVE_CONFIG_H -#include "config.h" -#endif - -#include <stdio.h> -#include <string.h> -#include <sys/types.h> -#include <unistd.h> - -#include "maxdimc.h" -#include "io.h" -#include "miriad.h" - -#define OLD 1 -#define NEW 2 -#define MK_FLAGS 1 -#define MK_RUNS 2 -#define check(x) if(x)bugno_c('f',x) -#define CHECK(x,a) if(x) { bug_c('w',((void)sprintf a,message)); \ - bugno_c('f',x); \ - } -#define ERROR(sev,a) bug_c(sev,((void)sprintf a,message)) - -static char message[132]; - -static struct { - char *mask; - int image; - int naxis,axes[MAXNAX],mask_exists,image_exists; - off_t offset; -} images[MAXOPEN]; - -#define Strcpy (void)strcpy - -static void xymkopen_c(int thandle,int mode); - -/************************************************************************/ -void xyopen_c(int *thandle,Const char *name,Const char *status,int naxis,int *axes) -/**xyopen -- Open an image file. */ -/*:image-i/o */ -/*+ FORTRAN call sequence: - - subroutine xyopen(tno,name,status,naxis,axes) - integer tno,naxis,axes(naxis) - character name*(*),status*(*) - - This opens an image file. For an old file, determine the size of - each axe. For a new file, it writes out this info. - - Input: - name The name of the file to be opened. - status Either 'old', 'new' or 'append'. - naxis The maximum number of axes that the calling program can - handle. For an 'old' file, if the data file has fewer - than naxis axes, the higher dimensions are treated as having - only one element. If the data file has more than naxis - axes, and the higher dimensions are more than 1 element - deep, xyopen bombs out. - Input or Output: - axes This is input for status='new' and output for status='old'. - It gives the number of elements along each axis. - Output: - tno The handle of the output file. */ -/*----------------------------------------------------------------------*/ -{ - int iostat,length,access,tno,i,ndim,npix,temp; - char *stat,*mode,naxes[16],s[ITEM_HDR_SIZE]; - - if(!strcmp("old",status)) { access = OLD; mode = "read"; stat = "old";} - else if(!strcmp("append",status)){ access = OLD; mode = "append";stat = "old";} - else if(!strcmp("new",status)) { access = NEW; mode = "write"; stat = "new";} - else - ERROR('f',(message,"Unrecognised status when opening %s, in XYOPEN",name)); - - if(naxis > MAXNAX) - /* If the above is true, the current code scribbles off the end - * of image[tno].axes. With a bit of work we could probably - * handle this situation, but it's a lot easier to just say - * "don't do this." */ - ERROR('f',(message,"Program wanted %d axes but XYOPEN can only provide %d", - naxis,MAXNAX)); - -/* Access the image data. */ - - hopen_c(&tno,name,stat,&iostat); - CHECK(iostat,(message,"Error opening %s, in XYOPEN",name)); - haccess_c(tno,&(images[tno].image),"image",mode,&iostat); - CHECK(iostat,(message,"Error accessing pixel data of %s, in XYOPEN",name)); - -/*----------------------------------------------------------------------*/ -/* */ -/* Handle an old image. Get number of axes, and then the length */ -/* of each axis. Also compute and check that the size of the */ -/* image file looks OK. */ -/* */ -/*----------------------------------------------------------------------*/ - - if(access == OLD){ - rdhdi_c(tno,"naxis",&ndim,0); - if(ndim <= 0 || ndim > MAXNAX) - ERROR('f',(message,"Bad number of dimensions for %s in XYOPEN",name)); - - Strcpy(naxes,"naxis0"); - length = strlen(naxes) - 1; - npix = 1; - for(i=0; i<max(ndim,naxis); i++){ - naxes[length] ++; - if(i < ndim) rdhdi_c(tno,naxes,&temp,0); - else temp = 1; - if(temp <= 0) - ERROR('f',(message,"Bad image dimension for %s, in XYOPEN",name)); - npix = npix * temp; - if(i < naxis) axes[i] = temp; - else if(temp > 1) - ERROR('f',(message,"Too many dimensions for %s, in XYOPEN",name)); - } - -/* Check the file size if OK and that it starts with the "real_item" - sequence. */ - - if(hsize_c(images[tno].image) < H_REAL_SIZE*npix+ITEM_HDR_SIZE) - ERROR('f',(message,"Pixel data for %s appears too small, in XYOPEN",name)); - hreadb_c(images[tno].image,s,0,ITEM_HDR_SIZE,&iostat); - CHECK(iostat,(message,"Error reading pixel data label for %s, in XYOPEN",name)); - if( memcmp(s,real_item,ITEM_HDR_SIZE) ) - ERROR('f',(message,"Bad pixel data label for %s, in XYOPEN",name)); - -/*----------------------------------------------------------------------*/ -/* */ -/* A new image. Write out all the axes infomation, and initialise */ -/* the file with the "binary item" sequence. */ -/* */ -/*----------------------------------------------------------------------*/ - - } else { - wrhdi_c(tno,"naxis",naxis); - Strcpy(naxes,"naxis0"); - length = strlen(naxes) - 1; - for(i=0; i < naxis; i++){ - naxes[length] ++; - wrhdi_c(tno,naxes,axes[i]); - } - hwriteb_c(images[tno].image,real_item,0,ITEM_HDR_SIZE,&iostat); - CHECK(iostat,(message,"Error writing pixel data label for %s, in XYOPEN",name)); - } - -/* Common to old and new. Copy the dimension info to the local description. */ - - images[tno].offset = 0; - images[tno].naxis = naxis; - for(i=0; i < naxis; i++) images[tno].axes[i] = axes[i]; - for(i = naxis; i < MAXNAX; i++) images[tno].axes[i] = 1; - images[tno].mask = NULL; - images[tno].image_exists = TRUE; - images[tno].mask_exists = TRUE; - *thandle = tno; -} -/************************************************************************/ -void xyflush_c(int thandle) -/**xyflush -- Flush out any image changes to disk. */ -/*:image-i/o */ -/*+ FORTRAN call sequence: - - subroutine xyflush(tno) - implicit none - -This flushes any changes to an image to disk. - - Input: - tno The handle of the image file. */ -/*----------------------------------------------------------------------*/ -{ - int iostat,i; - off_t offset; - size_t nbytes, length; - float buf[MAXDIM]; - -/* Simply flush out the mask. */ - - if(images[thandle].mask != NULL) mkflush_c(images[thandle].mask); - -/* If its a new file, and not all the pixels have yet been written, - write zero pixels. First determine the proper size. */ - - nbytes = H_REAL_SIZE; - for(i=0; i < images[thandle].naxis; i++) nbytes *= images[thandle].axes[i]; - nbytes += ITEM_HDR_SIZE; - offset = hsize_c(images[thandle].image); - -/* Determine the number of bytes to pad, and then pad it. */ - - nbytes -= offset; - if(nbytes > 0)for(i=0; i < MAXDIM; i++)buf[i] = 0.0; - while(nbytes > 0){ - length = MAXDIM*H_REAL_SIZE; - if(length > nbytes) length = nbytes; - hwriter_c(images[thandle].image,buf,offset,length,&iostat); - CHECK(iostat,(message,"Error allocating space for image")); - offset += length; - nbytes -= length; - } - -/* Do it all now. */ - - hflush_c(thandle,&iostat); check(iostat); -} -/************************************************************************/ -void xyclose_c(int thandle) -/**xyclose -- Close up an image file. */ -/*:image-i/o */ -/*+ FORTRAN call sequence: - - subroutine xyclose(tno) - integer tno - - This closes an image file. - - Input: - tno The handle of the image file. */ -/*----------------------------------------------------------------------*/ -{ - int iostat; - - hdaccess_c(images[thandle].image,&iostat); check(iostat); - if(images[thandle].mask != NULL) mkclose_c(images[thandle].mask); - hclose_c(thandle); -} -/************************************************************************/ -void xyread_c(int thandle,int index,float *array) -/**xyread -- Read a row from an image. */ -/*:image-i/o */ -/*+ FORTRAN call sequence: - - subroutine xyread(tno,index,array) - integer tno,index - real array(*) - - This reads a single row from an image. This accesses the plane given - by the last call to xysetpl. - - Input: - tno The image file handle, returned by xyopen. - index The row number to read. This varies from 1 to NAXIS2. - Output: - array The read row. NAXIS1 elements are returned. */ -/*----------------------------------------------------------------------*/ -{ - off_t offset; - size_t length; - int iostat; - - length = H_REAL_SIZE * images[thandle].axes[0]; - offset = H_REAL_SIZE * images[thandle].offset + (index-1) * length + - ITEM_HDR_SIZE; - hreadr_c(images[thandle].image,array,offset,length,&iostat); - check(iostat); -} -/************************************************************************/ -void xywrite_c(int thandle,int index,Const float *array) -/**xywrite -- Write a row to an image. */ -/*:image-i/o */ -/*+ FORTRAN call sequence: - - subroutine xywrite(tno,index,array) - integer tno,index - real array(*) - - This writes a single row to an image. This accesses the plane given - by the last call to xysetpl. - - Input: - tno The image file handle, returned by xyopen. - index The row number to write. This varies from 1 to NAXIS2. - array The read row. NAXIS1 elements are written. */ -/*----------------------------------------------------------------------*/ -{ - off_t offset; - size_t length; - int iostat; - - length = H_REAL_SIZE * images[thandle].axes[0]; - offset = H_REAL_SIZE * images[thandle].offset + (index-1) * length + - ITEM_HDR_SIZE; - hwriter_c(images[thandle].image,array,offset,length,&iostat); - check(iostat); -} -/************************************************************************/ -void xymkrd_c(int thandle,int index,int *runs,int n,int *nread) -/**xymkrd -- Read the masking information for an image (runs format). */ -/*:image-i/o */ -/*+ FORTRAN call sequence: - - subroutine xymkrd(tno,index,runs,n,nread) - integer tno,index,n,nread - integer runs(n) - - This reads the masking information associated with a row of an image, - and returns it in "runs" format. - - Input: - tnoe The handle associated with the image. - index The index of the row to determine mask info about. The - last call to xysetpl determines which plane to access. - n The size of the array to receive the mask info. - Output: - runs The mask info, in "runs" form. If "i" varies from 1 to - nread/2, then pixels runs(2*i-1) to runs(2*i) are - good, whereas pixels runs(2*i) to runs(2*i+1) are bad. - nread The number of "runs" read. */ -/*----------------------------------------------------------------------*/ -{ - off_t offset; - size_t length; - - if(images[thandle].mask == NULL && images[thandle].mask_exists) - xymkopen_c(thandle,OLD); - if(images[thandle].mask_exists){ - length = images[thandle].axes[0]; - offset = images[thandle].offset + (index-1) * length; - *nread = mkread_c(images[thandle].mask,MK_RUNS,runs,offset,length,n); - } else { - if(n < 2) - bug_c('f',"xymkrd_c: Runs array overflow"); - runs[0] = 1; - runs[1] = images[thandle].axes[0]; - *nread = 2; - } -} -/************************************************************************/ -void xymkwr_c(int thandle,int index,Const int *runs,int n) -/**xymkwr -- write image masking information (runs format). */ -/*:image-i/o */ -/*+ FORTRAN call sequence: - - subroutine xymkwr(tno,index,runs,n) - integer tno,index,n - integer runs(n) - - This writes out the masking information associated with a row of an image. - This information is passes in in "runs" format. - - Input: - tnoe The handle associated with the image. - index The index of the row to determine mask info about. The - last call to xysetpl determines which plane to access. - n The size of the array containing the mask info. - runs The mask info, in "runs" form. If "i" varies from 1 to - nread/2, then pixels runs(2*i-1) to runs(2*i) are - good, whereas pixels runs(2*i) to runs(2*i+1) are bad. */ -/*----------------------------------------------------------------------*/ -{ - off_t offset; - size_t length; - - if(images[thandle].mask == NULL) xymkopen_c(thandle,NEW); - if(images[thandle].mask == NULL) - bug_c('f',"xymkwr_c: Error writing to image mask file"); - length = images[thandle].axes[0]; - offset = images[thandle].offset + (index-1) * length; - mkwrite_c(images[thandle].mask,MK_RUNS,runs,offset,length,n); -} -/************************************************************************/ -void xyflgwr_c(int thandle,int index,Const int *flags) -/**xyflgwr -- Write image masking information (flags format). */ -/*:image-i/o */ -/*+ FORTRAN call sequence: - - subroutine xyflgwr(tno,index,flags) - integer tno,index - logical flags(*) - - This writes image mask information. It is the counterpart of xywrite. - Input: - tno Handle of the image file. - index The row in a plane to write out. This varies between 1 and - NAXIS2. See xysetpl to set the which plane is to be - accessed. - flags A logical array of NAXIS1 elements. A true value indicates - that the pixel is good. */ -/*----------------------------------------------------------------------*/ -{ - off_t offset; - size_t length; - - if(images[thandle].mask == NULL)xymkopen_c(thandle,NEW); - if(images[thandle].mask == NULL) - bug_c('f',"xyflgwr_c: Error writing to image mask file"); - length = images[thandle].axes[0]; - offset = images[thandle].offset + (index-1) * length; - mkwrite_c(images[thandle].mask,MK_FLAGS,flags,offset,length,length); -} -/************************************************************************/ -void xyflgrd_c(int thandle,int index,int *flags) -/**xyflgrd -- Read image masking information (flags format). */ -/*:image-i/o */ -/*+ FORTRAN call sequence: - - subroutine xyflgrd(tno,index,flags) - integer tno,index - logical flags(*) - - This reads image mask information. It is the counterpart of xyread. - Input: - tno Handle of the image file. - index The row in a plane to read in. This varies betwen 1 and - NAXIS2. Set xysetpl to change the plane being accessed. - Output: - flags A logical array of NAXIS1 elements. A true value indicates - that the pixel is good. */ -/*----------------------------------------------------------------------*/ -{ - int n,i; - off_t offset; - size_t length; - - if(images[thandle].mask == NULL && images[thandle].mask_exists) - xymkopen_c(thandle,OLD); - if(images[thandle].mask_exists){ - length = images[thandle].axes[0]; - offset = images[thandle].offset + (index-1) * length; - n = mkread_c(images[thandle].mask,MK_FLAGS,flags,offset,length,length); - } else { - n = images[thandle].axes[0]; - for(i=0; i<n; i++) *flags++ = FORT_TRUE; - } -} -/************************************************************************/ -static void xymkopen_c(int thandle,int mode) -/* - This opens the masking file. - - Input: - thandle The handle of the image data-set. - mode Either OLD or NEW. -------------------------------------------------------------------------*/ -{ - images[thandle].mask = mkopen_c(thandle,"mask",(mode == OLD ? "old" : "new")); - if(images[thandle].mask == NULL) images[thandle].mask_exists = FALSE; -} -/************************************************************************/ -void xysetpl_c(int thandle,int naxis,Const int *axes) -/**xysetpl -- Set which plane of a cube is to be accessed. */ -/*:image-i/o */ -/*+ FORTRAN call sequence: - - subroutine xysetpl(tno,naxis,nsize) - integer tno,naxis,nsize(naxis) - - This sets up which plane of a cube is to be accessed. - - Input: - tno Handle of the image file. - naxis Size of the "nsize" array. - nsize This gives the indices, along the 3rd, 4th, 5th, etc - dimensions, of the plane that is to be accessed. nsize(1) - corresponds to the index along the 3rd dimension. */ -/*----------------------------------------------------------------------*/ -{ - int i; - size_t size; - - if(naxis+2 > MAXNAX) - bug_c('f',"xysetpl_c: Too many dimensions"); - size = 0; - for(i=naxis-1; i >= 0; i--){ - if(axes[i] < 1 || axes[i] > images[thandle].axes[i+2]) { - printf("i=%d axis[i]=%d images[thandle].axes[i+2]=%d\n", - i, axes[i], images[thandle].axes[i+2]); - bug_c('f',"Dimension error in XYSETPL"); - } - size = ( size + axes[i] - 1) * images[thandle].axes[i+1]; - } - images[thandle].offset = size * images[thandle].axes[0]; -} Index: casacore-3.5.0/mirlib/xyzio.c =================================================================== --- casacore-3.5.0.orig/mirlib/xyzio.c +++ /dev/null @@ -1,2034 +0,0 @@ -/******************************************************************************* - - Routines to read and write an image dataset in arbitrary XYZ mode - - History: - - bpw 19-apr-91 Created - bpw 01-may-91 Algorithm ready - bpw 03-may-91 Ready - bpw 19-may-91 Add reverse - bpw 20-may-91 Include dummy masking scheme - bpw 21-jun-91 Installed - bpw 25-jun-91 Created get_buflen function - bpw 27-jun-91 Moved FORTRAN-C conversion to xyziowrap.h - pjt/mjs 28jul91 Renamed internal variable "max" to "themax" to eliminate - conflict with max function. - bpw 29-jul-91 Got rid of themax, and made it into sizeof - bpw 09-aug-91 Added '-start' to bufend in zero(2) - bpw 08-sep-92 Made ndata indeed output variable for xyzread - rjs 22-dec-92 Delete inclusion of xyziowrap.h in xyzio.h - rjs 23-feb-93 Include maxdimc.h, which includes definition of MAXNAX - and MAXBUF. Use MAXBUF. Get rid of xyzio.h - bpw 2-mar-93 Add real masking - bpw 9-jul-93 Added xyzflush_c and xyzmkbuf_c, and changed buffer - allocation scheme to avoid unnecessary allocations - bpw 27-jul-93 Fixed allocation bug introduced in previous update - (problems for 1-plane datasets) - rjs 4-sep-94 Change "word" to "words" to satisfy Cray compiler. - rjs 6-nov-94 Change item handle to an integer. - bpw 8-dec-94 Adapt two loop in bufferalloc for the fact that since - 6 nov image handles are no longer in sequence. - bpw 12-feb-96 follow rjs to eliminate nested comments (without using - tabs) - bpw 12-jun-98 for zero(1,tno) set whole cube mask to FALSE - pjt 16-nov-00 Fixed a pretty serious problem of bpw mixing up | w/ || - and & w/ &&. - Also forced initialized of mask due, there were some - side-effects here too if no mask was present - (note xyzio writes a mask, even if full mask ok) - pjt 11-jun-01 added rjs' 10-jan-96 code changes that seemed lost - "Correct comparision bug in bufferallocation routine." - pjt 20-jun-02 prototypes for MIR4, made most local stuff now static, - largely thanks to Amtrak for a long boring ride NYC-NCR - pjt 14-jan-03 cleared up some more prototypes, fixed bug in - *s[ITEM_HDR_SIZE] declaration (no pointer, just char) - jwr 18-may-05 print address using %p instead of %d - rjs 18-sep-05 Added routine xyzdim_. - mhw 09-mar-12 Replace a lot of int's with long's to cope with - large cubes (>8GB) - pjt 28-jun-12 Fixed get_buflen() , fix (?) usage of MAXBUF - pjt 22-jan-13 bufferallocation() : another forgotten 64bit allocation - -*******************************************************************************/ - -/******************************************************************************/ -/* */ -/* Declarations */ -/* */ -/******************************************************************************/ - -#include <stdio.h> -#include <string.h> -#include <stdlib.h> -#include "miriad.h" -#include "io.h" -#include "maxdimc.h" - -#define check(x) if(x)bugno_c('f',x) - -/* There is only one buffer array, of a length determined at run-time by - get_buflen. - buffersize is size of the virtual buffer for a particular image, - which varies with the number of images handled (ntno) */ -static long buffersize; -static int allocatebuffer, neverfree=FALSE; -static long currentallocation=0; -static float *buffer = NULL; /* data */ -static int *mbuffr = NULL; /* mask */ - - -/* Most of the code for reading and writing is exactly the same. Where a - difference exists MODE (values GET and PUT) is used to discriminate. - UP and DOWN are used for copying or reverse copying. - ALL is used to see if all axes are reversed. */ -static int MODE; - -#define GET 0 -#define PUT 1 -#define UP 1 -#define DOWN 2 -#define ALL 2 - - -/* MAXNAX: maximum number of axes that this can handle. - ARRSIZ = MAXNAX+1, so that element 1<->x, 2<->y, etc */ -#define ARRSIZ MAXNAX+1 - - -/* imgs: dataset info; bufs: buffers info - .itno: image handle for hio routines - .number: counter of how many datasets were opened before - .naxis, .axlen, .cubesize, .blc, .trc: you know - .lower, .upper: lower and upper coordval of elements currently in buffer - .filfir, .fillas: first and last element from cube currently in buffer - .bufstart: abbreviation for -.filfir+tno*buffersize - .lastwritten: to see if old data must be read in before writing buffer - .nocopy: true if no transposition or region present - axnum: relation between axes: i-th axis used to be axis axnum(i) - reverse: tells if output data array must be reversed - written: to see if buffer must be flushed on a close or new read to same - newbuffer: to allow a check if xyzsetup is called more often for a dataset - ntno: number of datasets currently opened -*/ -static struct { int itno; char *mask; int number; - int naxis, axlen[ARRSIZ]; - long cubesize[ARRSIZ]; - int blc[ARRSIZ], trc[ARRSIZ]; - int lower[ARRSIZ], upper[ARRSIZ]; - long filfir, fillas, bufstart; - long lastwritten; - int nocopy; -} imgs[MAXOPEN], bufs[MAXOPEN]; -static int axnum[MAXOPEN][ARRSIZ]; -static int reverse[MAXOPEN][ARRSIZ]; -static int written[MAXOPEN]; -static int ntno = 0; - -/* loop variables (dim and d) and dimension of subcube */ -static int dim, d, dimsub[MAXOPEN]; - -/* arrays used to limit number of pointer calculations inside big loop - in loop_inpbuffer (i.e. remove index [tno]) and to improve readability - of the code */ -static int naxes; -static int imgsblc[ARRSIZ], imgstrc[ARRSIZ]; -static int imgslower[ARRSIZ], imgsupper[ARRSIZ]; -static int imgsaxlen[ARRSIZ]; -static long imgscubesize[ARRSIZ], imgscsz[ARRSIZ]; -static int bufsblc[ARRSIZ], bufstrc[ARRSIZ]; -static int bufsaxlen[ARRSIZ]; -static long bufscubesize[ARRSIZ], bufscsz[ARRSIZ]; -static int axnumr[ARRSIZ], inv_axnumr[ARRSIZ], reverses[ARRSIZ]; - - -/* Some variables not used, but left in for the (hopefully never occuring) - case that an error occurred and debugging is needed. - Most if(.test) statements have been left active. Some, the ones in inner - loops, are disabled. They can be found by searching for '/ * $ $' (without spaces) */ - -static int itest = 0; /* Information on buffers and datasets */ -static int otest = 0; /* Information on subcubes */ -static int rtest = 0; /* Information on each array element */ -static int vtest = 0; /* Puts numbers in buffer without reading a dataset */ -static int tcoo[ARRSIZ]; -static int nfound, i; -static char *words[4] = { "get", "put", "filled", "emptied" }; -static int nio=0; - -/* static functions */ -static void get_test(int interactive); -static int putnio(int x); -static void ferr(char *string, int arg); -static void get_put_data(int tno, long virpix_off, float *data, int *mask, int *ndata, int dim_sub); -static void do_copy(float *bufptr, float *bufend, int DIR, float *data, int *mask); -static void manage_buffer(int tno, long virpix_off); -static void manage_the_buffer(int tno, long virpix_off); -static void get_buflen(void); -static long bufferallocation(long n); -static void copy_to_one_d(int tno); -static void set_bufs_limits(int tno, long virpix_off); -static long get_last(long start, long finis); -static int check_do_io(int tno, long start, long last); -static void find_block(long start, long last, int lower[], int upper[], int axlen[], long cubesize[], int blc[], int trc[], int naxis); -static long transform_back(long pix_off); -static long c2p(int coords[], long cubesize[], int naxis); -static void p2c(long pix_off, int axlen[], long cubesize[], int naxis, int coords[]); -static void fill_buffer(int tno, long start, long last); -static void empty_buffer(int tno, long start, long last); -static void loop_buffer(int tno, long start, long last, long *newstart); -static void zero(int bl_tr, int tno); -static void testprint(int tno, long virpix_off, long virpix_lst); -static void limprint(char *string, int lower[], int upper[]); -static void testsearch(int callnr, int coords[], long filoff, long viroff); - - static void get_test(int interactive) -{ - if(interactive)printf("iTest >"); scanf("%d",&itest); - if(interactive)printf("rTest >"); scanf("%d",&rtest); - if(interactive)printf("oTest >"); scanf("%d",&otest); - if(interactive)printf("vTest >"); scanf("%d",&vtest); -} - -static int putnio(int x) -{ - return nio; -} - - -/******************************************************************************/ -/* */ -/* The FORTRAN-callable routines */ -/* */ -/******************************************************************************/ - -/** xyzopen -- Open an image file. */ -/*& bpw */ -/*: image-i/o */ -/*+ - subroutine xyzopen( tno, name, status, naxis, axlen ) - integer tno - character*(*) name - character*(*) status - integer naxis - integer axlen(naxis) - -This opens an image file. For an old file, the number of axes is returned in -naxis and the size of each axis in axlen. For a new file, this information is -used to define the dataset. - Input: - name The name of the file to be opened - status Either 'old' or 'new' - Output: - tno The image-file handle - Input or Output: - naxis For 'old' datasets: in input dimension of array axlen, on - output dimension of datacube; for 'new' datasets: dimension - of new dataset - axlen The length of the axes, output for 'old' datasets, 'input' - for 'new' datasets */ -/*-- */ - -void xyzopen_c( int *handle, Const char *name, Const char *status, - int *naxis, int *axlen ) -{ -/* This accesses the image data (hopen and haccess). Then it checks whether - this was an OLD dataset. If so, the naxis. items are read from the header - and a check is made on the size of the image file. For a new dataset the - information is written out and the file initialized with the "binary item" - sequence. Finally the information is stored in the imgs structure for later - use. -*/ -#define OLD 1 -#define NEW 2 - int access, n_axis, tno, iostat; - long cubesize; - char s[ITEM_HDR_SIZE], axes[8], *mode; - static int first=TRUE; - - if(first) { for(tno=0;tno<MAXOPEN;tno++) imgs[tno].itno=0; first=FALSE; } - - if(itest)printf("Open %s; %s; naxis %d\n",name,status,*naxis); - n_axis = *naxis; - if( !strcmp( "old", status ) ) { access = OLD; mode = "read"; } - else if( !strcmp( "new", status ) ) { access = NEW; mode = "write"; } - else { bug_c( 'f', "xyzopen: Unrecognised status" ); printf("bug\n"); } - - hopen_c( &tno, name, status, &iostat ); check(iostat); - haccess_c( tno, &imgs[tno].itno, "image", mode, &iostat ); check(iostat); - imgs[tno].mask = (char *)mkopen_c( tno, "mask", (char *) status ); - - strcpy( axes, "naxis0" ); - if( access == OLD ) { - rdhdi_c( tno, "naxis", naxis, 0 ); - if( *naxis > n_axis ) bug_c('f',"xyzopen: Too many axes for this task"); - if( *naxis<=0||*naxis>MAXNAX ) bug_c('f',"xyzopen: Bad number of axes"); - for( cubesize=1, d=0; d<*naxis; d++ ) { - axes[5]++; rdhdi_c( tno, axes, &axlen[d], 0 ); - if( axlen[d] <= 0 ) bug_c( 'f', "xyzopen: Bad image dimension" ); - cubesize = cubesize * axlen[d]; - } - if( hsize_c( imgs[tno].itno ) < H_REAL_SIZE*cubesize+ITEM_HDR_SIZE ) - bug_c( 'f', "xyzopen: Image file appears too small" ); - hreadb_c( imgs[tno].itno, s,0,ITEM_HDR_SIZE, &iostat ); - check(iostat); - if( memcmp( s, real_item, ITEM_HDR_SIZE ) ) - bug_c( 'f', "xyzopen: Bad image file" ); - } else { - wrhdi_c( tno, "naxis", *naxis ); - for( d=0; d<*naxis; d++ ) { - axes[5]++; wrhdi_c( tno, axes, axlen[d] ); - } - hwriteb_c( imgs[tno].itno, real_item,0,ITEM_HDR_SIZE, &iostat ); - check(iostat); - } - - imgs[tno].naxis = *naxis; - imgs[tno].cubesize[0] = 1; - imgs[tno].axlen[0] = 1; - for( d=1; d<=*naxis; d++ ) { - imgs[tno].axlen[d] = axlen[d-1]; - imgs[tno].cubesize[d] = imgs[tno].cubesize[d-1] * imgs[tno].axlen[d]; - } - if( access == OLD ) imgs[tno].lastwritten = imgs[tno].cubesize[*naxis]; - else imgs[tno].lastwritten = -1; - - *handle = tno; - ntno++; - imgs[tno].number = ntno; - dimsub[tno] = -1; -} -/******************************************************************************/ -/** xyzdim - Return dimension information. */ -/*& rjs */ -/*: image-i/o */ -/*+ - subroutine xyzdim(tno,naxis,dimsub - integer tno,naxis,dimsub - -This returns dimension information. - - Input: - tno The image file handle. - Output: - naxis Number of dimensions. - dimsub Number of skipped subdimensions. */ -/*--*/ - -void xyzdim_c(int tno,int *naxis,int *subdim) -{ - *naxis = imgs[tno].naxis; - *subdim = dimsub[tno]; -} -/******************************************************************************/ -/** xyzpix - Return information on number of pixels. */ -/*& rjs */ -/*: image-i/o */ -/*+ - integer function xyzpix(tno,dims) - integer tno,dim - -This returns dimension information. - - Input: - tno The image file handle. - dim Dimension information. */ -/*--*/ - -int xyzpix_c(int tno,int dims) -{ - int dim_sub; - dim_sub = dims; - if(dim_sub == 0)dim_sub = dimsub[tno]; - return(bufs[tno].cubesize[dim_sub]); -} -/******************************************************************************/ -/** xyzclose - Close an image file */ -/*& bpw */ -/*: image-i/o */ -/*+ - subroutine xyzclose( tno ) - integer tno - -This closes an image file. - - Input: - tno: The image-file handle */ -/*--*/ - -void xyzclose_c( int tno ) -{ - int iostat; - xyzflush_c( tno ); - hdaccess_c( imgs[tno].itno, &iostat ); check(iostat); - if( imgs[tno].mask ) mkclose_c( imgs[tno].mask ); - hclose_c( tno ); - ntno--; - if( ntno == 0 && !neverfree ) { - free( buffer ); buffer = NULL; - free( mbuffr ); mbuffr = NULL; - } -} -/******************************************************************************/ -/** xyzflush - Force output buffer to be written to disk */ -/*& bpw */ -/*: image-i/o */ -/*+ - subroutine xyzflush( tno ) - integer tno - -This flushes the output buffer to disk, just like when closing a dataset. -However, the dataset remains open. This is intended for usage where there -is a limit on the number of open datasets, so that one cannot have them -open all at the same time, and then do all setups once. - - Input: - tno: The image-file handle */ -/*--*/ - -void xyzflush_c( int tno ) -{ - if( written[tno] ) { MODE=PUT; manage_buffer( tno, -1 ); } - written[tno] = FALSE; - if( imgs[tno].lastwritten<imgs[tno].cubesize[imgs[tno].naxis] ) zero(2,tno); -} -/******************************************************************************/ -/** xyzsetup - Set up arbitrary subcube */ -/*& bpw */ -/*: image-i/o */ -/*+ - subroutine xyzsetup( tno, subcube, blc, trc, viraxlen, vircubesize ) - integer tno - character*(*) subcube - integer blc(*), trc(*) - integer viraxlen(*) - ptrdiff vircubesize(*) - -This routine does the definitions necessary to allow reading or writing -an arbitrary subcube in a n-dimensional datacube. It is used to define -which part of an input datacube should be read or which part of an -output datacube should be written. - -The variable subcube is used to define the axes of the subcubes to be -read or written. The axes of a datacube are called 'x', 'y', 'z', 'a', -'b', ... 'subcube' consists of any non-redundant combination of these. -Zero-dimensional subcubes, i.e. single pixels, are specified by setting -'subcube' to ' '. 'subcube' can be e.g. 'z' to read/write lines in the -z-direction, 'xy' to read/write image planes or 'xyz' to read/write a -3-d subcube. Permutations (like 'zx') are also permitted. These will be -reflected in the ordering of the output array produced by subroutine -xyzread. Axis reversals are also possible, and are set up by preceding -the axis name with a '-'. Again, this will be reflected in the ordering -of elements in the output array of xyzread. -If xyzsetup is used to define an output cube, the subcube variable -should be interpreted as giving the names of the axes in the virtual -cube. E.g., for subcube='z', the first axis in the virtual cube is the -z-axis of the output cube. The second axis then is the 'x' axis, etc. - -blc and trc give the bottom left and top right corner of the total -region of the input cube that needs to be worked on (in absolute pixels, -i.e. the bottom left of the original cube is 1,1,...), or the total -region of the output cube that should be written. If the output cube -did not yet exist and the region is smaller than the defined size of -the cube, the pixels outside the region are set to zero automatically. - -viraxlen and vircubesize are provided for the convenience of the -programmer. They correspond to a virtual cube, whose axes are permuted -according to the specification of 'subcube', and whose axislengths are -given by the differences of blc and trc. This virtual (intermediate) -cube contains all the pixels on which the calling program should work, -sorted in the order in which they are needed. - -With a call to xyzsetup all previous buffers are irrevocably lost; but -output buffers are flushed before that. However, all calls to xyzsetup -should be done before working on the data. - - Input: - tno image file handle - subcube a character variable defining the subcube type - blc, trc arrays giving the bottom left and top right corner - of the region in the input/output cube to work on/ - write; the number of elements used equals the - dimension of the input/output cube - Output: - viraxlen: length of axes of virtual cube - vircubesize: size of subcubes: - vircubesize(d) = Prod(i=1->d) viraxlen(i) */ -/*--*/ - -void xyzsetup_c( int tno, Const char *subcube, Const int *blc, Const int *trc, - int *viraxlen, long *vircubesize ) -{ -/* This initializes some information needed later. It keeps separate values - for each tno that was opened. - dimsub: dimension of subcube - axnum: relation between axes - imgs.blc, imgs.trc: lower left and upper right used from input or - written to output - bufs.axlen: length of virtual axes - imgs/bufs.cubesize: cs(i) = (Prod)(d<i) axlen(d): # pix in line/plane etc - viraxlen, vircubesize: info returned to caller -*/ - - int axisuse[ARRSIZ]; char *axisnames = { "xyzabcdefghij" }; - char *sub_cube; int reversal; - int naxes; - -/* Because a new call to xyzsetup redefines all buffers, they are flushed - before the redefinition is done */ - for( i=0; i<MAXOPEN; i++ ) { - if( written[i] ) { MODE=PUT; manage_buffer( i, -1 ); } - written[i] = FALSE; - } - -/* Intermediate variable for easier reading */ - naxes = imgs[tno].naxis; - -/* Decode subcube argument into dimsub, and axnum and reverse arrays */ - dim=0; - for( d=1;d<=MAXNAX;d++ ) axisuse[d]=FALSE; - reversal=FALSE; - sub_cube=(char *)subcube; - while( *subcube ) { - if( *subcube == ' ' ) { ; - } else if( *subcube == '-' ) { - if( reversal ) bug_c( 'f', "xyzsetup: Bad syntax for subcube arg" ); - reversal=TRUE; if(itest)printf("reversal"); - } else { - d=1; - while( *subcube != *(axisnames+d-1) && d<=naxes && *axisnames ) d++; - if( d>naxes || !*axisnames ) - ferr( "xyzsetup: Axis outside cube", *subcube ); - if(axisuse[d])ferr("xyzsetup: Axis given more than once",*subcube); - dim++; - axisuse[d]=TRUE; reverse[tno][dim]=reversal; axnum[tno][dim]=d; - reversal=FALSE; - } - subcube++; - } - dimsub[tno] = dim; - subcube = sub_cube; -/* Fill out the arrays axnum and reverse, so that all elements are defined */ - for( reverse[tno][0]=FALSE, d=0, dim=1; dim<=dimsub[tno]; dim++ ) { - if( reverse[tno][dim] ) { reverse[tno][0]=TRUE; d++; } } - if( d == dimsub[tno] ) reverse[tno][0]=ALL; - for( d=1; d<=MAXNAX; d++ ) { if( !axisuse[d] ) { - axnum[tno][dim]=d; reverse[tno][dim]=FALSE; dim++; } } - -/* Save blc and trc */ - for( dim=1; dim<=naxes; dim++ ) { - if( ( blc[dim-1] < 1 ) || ( trc[dim-1] > imgs[tno].axlen[dim] ) ) - bug_c( 'f', "xyzsetup: Subcube blc and/or trc outside range" ); - imgs[tno].blc[dim] = blc[dim-1]-1; - imgs[tno].trc[dim] = trc[dim-1]-1; - } - -/* Save axislengths and cubesizes */ - bufs[tno].naxis = naxes; - bufs[tno].axlen[0] = 1; - bufs[tno].cubesize[0] = 1; - for( dim=1; dim<=naxes; dim++ ) { - bufs[tno].axlen[dim] = imgs[tno].trc[ axnum[tno][dim] ] - - imgs[tno].blc[ axnum[tno][dim] ] + 1; - } - for( dim=1; dim<=naxes; dim++ ) { - bufs[tno].cubesize[dim]=bufs[tno].cubesize[dim-1]*bufs[tno].axlen[dim]; - } - -/* More initializations: - pointers to window in file that is in buffer; - variable indicating if write buffer was filled; - variable indicating if any transposition must be done; */ - for( d=0; d<MAXOPEN; d++ ) { bufs[d].filfir = -1; bufs[d].fillas = -1; } - written[tno] = FALSE; - imgs[tno].nocopy = TRUE; - for( dim=1; dim<=naxes; dim++ ) - if( dim != axnum[tno][dim] ) imgs[tno].nocopy = FALSE; - for( dim=1; dim<=naxes; dim++ ) { - if( blc[dim-1] != 1 || trc[dim-1] != imgs[tno].axlen[dim] ) - imgs[tno].nocopy = FALSE; - } - -/* Some info for the caller */ - for( dim=1; dim<=naxes; dim++ ) { - viraxlen[dim-1] = bufs[tno].axlen[dim]; - vircubesize[dim-1] = bufs[tno].cubesize[dim]; - } - -/* Set flag so that manage_buffer knows it has to (re)calculate the buffersize */ - allocatebuffer = TRUE; - -/* Testoutput only */ - if(itest){ - printf("tno %d\n",tno); - printf("d incsz vircsz inaxlen viraxlen axnum\n"); - for( dim=1; dim<=naxes; dim++ ) - printf("%d %10ld %10ld %10d %10d %10d\n", - dim, imgs[tno].cubesize[dim],bufs[tno].cubesize[dim], - imgs[tno].axlen[dim], viraxlen[dim-1], axnum[tno][dim]); - } - -} - -static void ferr( char *string, int arg ) -{ - char message[80]; char *msg; - msg = &message[0]; - while( *string != '\0' ) *msg++ = *string++; - *msg++ = ':'; *msg++ = ' '; *msg++ = arg; *msg = '\0'; - bug_c( 'f', message ); -} -/******************************************************************************/ -/** xyzmkbuf - create the i/o buffer (only once) */ -/*& bpw */ -/*: image-i/o */ -/*++ - subroutine xyzmkbuf - -Usually, xyzio tries to be smart about allocating its own buffer and tries -to minimize its memory use. This works well if all calls to xyzsetup can -be done before any reading or writing is done. However, it may allocate -too much memory if calls to xyzsetup are followed by calls to xyzclose so -that all datasets are closed, and then more opens and setups are done. To -circumvent this, xyzmkbuf creates an i/o buffer of maximum size, and makes -sure it is never deallocated. */ -/*--*/ - -void xyzmkbuf_c() -{ - (void) bufferallocation( MAXBUF ); - neverfree = TRUE; -} -/******************************************************************************/ -/** xyzs2c - Get the fixed coordinates for a given subcube */ -/*& bpw */ -/*: image-i/o */ -/*++ - subroutine xyzs2c( tno, subcubenr, coords ) - integer tno - integer subcubenr - integer coords(*) - -This routine, xyzsetup and xyzread/xyzwrite work together to allow -reading/writing an arbitrary subcube in a n-dimensional datacube. -xyzs2c calculates the fixed coordinates of a particular subcube. -xyzsetup defines a particular type of subcube in a datacube, e.g. line -profiles in the z-direction. For a given subcube there are varying (z -in the example) and fixed coordinates. The subcubes are ordered along -the fixed-coordinate axes: the first subcube has (x=1,y=1), the second -has (x=2,y=1), etc. xyzs2c returns the values of the fixed coordinates -for a given subcubenumber. These can then be used as input to xyzread -or xyzwrite. - - Input: - tno The handle of the dataset - subcubenr Identification of the subcube - Output: - coords Coordinates of the blc of the subcube */ -/*--*/ - -void xyzs2c_c( int tno, long subcubenr, int *coords ) -{ -/* Calculates fixed coordinates of subcubenr: - first calculate pixeloffset of lower left of subcube; convert to - coordinates using virtual cube specifications; then add appropriate - lower left offset of input and shift so that first element is first - fixed axis. -*/ - int dim_sub, naxes; - long offset; - int coo[ARRSIZ]; - - dim_sub = dimsub[tno]; - naxes = bufs[tno].naxis; - offset = subcubenr * bufs[tno].cubesize[dim_sub]; - if( offset < 0 || offset >= bufs[tno].cubesize[naxes] ) - bug_c( 'f', "xyzs2c: Subcube lies outside cube" ); - p2c( offset, bufs[tno].axlen, bufs[tno].cubesize, naxes, coo ); - dim = dim_sub+1; - while( dim<=naxes ) { - coords[dim-dim_sub-1] = coo[dim] + imgs[tno].blc[axnum[tno][dim]] + 1; - dim++; } - - if(otest) { - printf( "\nsubcubenr %ld starts at vircube coords:", subcubenr ); - for( dim=1; dim<=naxes; dim++ ) printf(" %d",coo[dim]); - printf( "; orig. cube coords:" ); - for( dim=0; dim<naxes-dim_sub; dim++ ) printf( " %d", coords[dim]-1 ); - printf( "\nvir filfir %ld fillas %ld virpix_off %ld\n", - bufs[tno].filfir, bufs[tno].fillas, offset ); - } -} -/******************************************************************************/ -/** xyzc2s - Get the subcubenr at a fixed coordinate */ -/*& bpw */ -/*: image-i/o */ -/*++ - subroutine xyzc2s( tno, coords, subcubenr ) - integer tno - integer coords(*) - integer subcubenr - -This routine does the inverse of xyzs2c: it calculates the subcubenr -from a list of coordinates for a previously opened dataset after a -call to xyzsetup to define a particular type of subcube in a datacube. - - Input: - tno The handle of the dataset - coords Coordinates of the blc of the subcube - Output: - subcubenr Identification of the subcube */ -/*--*/ - -void xyzc2s_c(int tno, Const int *coords, long *subcubenr ) -{ -/* Calculates subcubenr at fixed coordinates: - Convert coordinates to virtual-cube coordinates, then calculate - virtual-cube offset and divide by subcubelength. -*/ - int dim_sub, naxes; - long offset; - int coo[ARRSIZ]; - - dim_sub = dimsub[tno]; - naxes = bufs[tno].naxis; - for( dim=1; dim<=dim_sub; dim++ ) coo[dim] = 0; - dim = 0; - while( dim < naxes-dim_sub ) { - coo[axnum[tno][dim+dim_sub+1]] = coords[dim] - imgs[tno].blc[dim] - 1; - dim++; } - offset = c2p( coo, bufs[tno].cubesize, naxes ); - if( offset < 0 || offset >= bufs[tno].cubesize[naxes] ) - bug_c( 'f', "xyzc2s: Coordinates lie outside cube" ); - *subcubenr = offset / bufs[tno].cubesize[dim_sub]; - - if(itest) { - printf( "\ncoords" ); - for( dim=1; dim<=naxes; dim++ ) printf(" %d",coo[dim]); - printf( " are for subcubenr %ld:", *subcubenr ); - printf( "; orig. cube coords:" ); - for( dim=0; dim<naxes-dim_sub; dim++ ) printf( " %d", coords[dim]-1 ); - printf( "\nvir filfir %ld fillas %ld virpix_off %ld\n", - bufs[tno].filfir, bufs[tno].fillas, offset ); - } -} -/******************************************************************************/ -/** xyzread - Read arbitrary subcube */ -/*& bpw */ -/*: image-i/o */ -/*+ - subroutine xyzread( tno, coords, data, mask, ndata ) - integer tno - integer coords(*) - real data(*) - logical mask(*) - integer ndata - -This routine, xyzsetup and xyzs2c work together to allow reading an -arbitrary subcube in a n-dimensional datacube. xyzread reads a subcube -from the datacube, as defined by xyzsetup at coordinates calculated by -xyzs2c. - -The array coords gives the coordinates of the axes complementary to the -subcube axes. E.g., if 'subcube' in the call to xyzsetup was 'y' and -the datacube is 3-dimensional, coords(1) and coords(2) give the 'x' and -'z' coordinate of the requested line profile, respectively. Or, if -'subcube' was 'xz', coords(1) gives the 'y'-coordinate of the plane. -For a datacube of dimension 'd', only the first 'd - dimsub' elements -of the array coords will be used (where 'dimsub' is the dimension of -the subcube). - -The array data (of dimension ndata) will hold the requested information. -If the subcube was 0-dimensional, the result is the pixel value. For a -1-d subcube the profile is returned in data. The number of returned -elements is vircubesize(1), as returned by xyzsetup. For a 2-d subcube -the array data gives the requested plane, as a 1-d array of length -vircubesize(2). Etc. - -The mask array indicates if pixels in the data array were undefined -(a TRUE value means the pixel is OK). Element 1 corresponds to data(1), -etc. -(this is not yet implemented, so all elements are returned as TRUE). - -N.B.: to scan a datacube pixel by pixel it is more efficient to use -subroutine xyzpixrd instead of xyzread, as the conversion from offset to -coordinates to offset that xyzs2c and xyzread do then is superfluous and -time-consuming. - - Input: - tno image file handle - coords array of which the first (dim cube)-(dim subcube) - elements are used, giving the coordinate values - along the complementary axes - Output: - data array containing data read in - mask FALSE values indicate undefined pixels - ndata number of elements read */ -/*--*/ - -void xyzread_c(int tno, Const int *coords, float *data, int *mask, int *ndata ) -{ -/* The calculation first needs the pixeloffset of the input coordinate. - For the varying axes the pixelnumber is 0, for the fixed axes of the - subcube, the pixelnumber is the input minus the lower left offset. - The input array had the first fixed coordinate as element 0, so a - shift of -1 is necessary. After finding the pixelnumber in the virtual - cube get_put_data is used. -*/ - long virpix_off; - int dim_sub, naxes; - dim_sub = dimsub[tno]; - naxes = bufs[tno].naxis; - virpix_off = 0; - dim = dim_sub+1; - while( dim <= naxes ) { - virpix_off += bufs[tno].cubesize[dim-1] * - ( coords[dim-dim_sub-1]-1 - imgs[tno].blc[ axnum[tno][dim] ] ); - dim++; } - MODE=GET; get_put_data( tno, virpix_off, data, mask, ndata, dim_sub ); -} -/******************************************************************************/ -/** xyzpixrd - Get a pixel from a dataset */ -/*& bpw */ -/*: image-i/o */ -/*+ - subroutine xyzpixrd( tno, pixelnr, value, mask ) - integer tno - integer pixelnr - logical mask - real value - -This routine provides a faster version of calls to xyzs2c and xyzread -for the case that the calling program needs single pixels. It should -be used after a call to xyzsetup was used to set up zero-dimensional -subcubes. The calling program can then loop over all pixels (from 1 to -vircubesize(naxis)). xyzpixrd takes care of reading the datacube. -Using this routine instead of xyzs2c and xyzread reduces the overhead -by more than a factor 10. - - Input: - tno image file handle - pixelnr pixelnr to be read from virtual cube - - Output: - value pixel value - mask FALSE if pixel was undefined */ -/*--*/ - -void xyzpixrd_c(int tno, long pixelnr, float *data, int *mask) -{ - long virpix_off; -#ifdef XYZ_DEBUG - if(otest) xyzs2c_c( tno, pixelnr-1, tcoo ); -#endif - virpix_off = pixelnr - 1; - if( virpix_off < bufs[tno].filfir || virpix_off > bufs[tno].fillas ) { - MODE=GET; manage_buffer( tno, virpix_off ); - } - *data = *( buffer + bufs[tno].bufstart + virpix_off ); - *mask = *( mbuffr + bufs[tno].bufstart + virpix_off ); -#ifdef XYZ_DEBUG - if(otest) testprint( tno, virpix_off, virpix_off ); -#endif -} -/******************************************************************************/ -/** xyzprfrd - Get a profile from a dataset */ -/*& bpw */ -/*: image-i/o */ -/*+ - subroutine xyzprfrd( tno, profilenr, profile, mask, ndata ) - integer tno - integer profilenr - real profile(*) - logical mask(*) - integer ndata - -This routine provides a (little) faster version for calls to xyzs2c and -xyzread for the case that the calling program needs profiles. It should -be used after a call to xyzsetup was used to set up one-dimensional -subcubes. The calling program can then loop over all profiles (from 1 to -vircubesize(naxis)/vircubesize(1)). xyzprfrd takes care of reading the -datacube. Using this routine instead of xyzs2c and xyzread reduces the -overhead by 10% (for 256-long profiles) to 30% (for 64-long profiles). - - Input: - tno image file handle - profilenr profile nr to be read from virtual cube - Output: - profile will contain the profile - mask FALSE values indicate undefined pixels - ndata number of elements read */ -/*--*/ - -void xyzprfrd_c(int tno, int profilenr, float *data, int *mask, int *ndata ) -{ - long virpix_off; -#ifdef XYZ_DEBUG - if(otest) xyzs2c_c( tno, profilenr-1, tcoo ); -#endif - virpix_off = (profilenr-1) * bufs[tno].cubesize[1]; - MODE=GET; get_put_data( tno, virpix_off, data, mask, ndata, 1 ); -} -/******************************************************************************/ -/** xyzplnrd - Get a plane from a dataset */ -/*& bpw */ -/*: image-i/o */ -/*+ - subroutine xyzplnrd( tno, planenr, plane, mask, ndata ) - integer tno - integer planenr - real plane(*) - logical mask(*) - integer ndata - -This routine provides a more convenient version of calls to xyzs2c and -xyzread for the case that the calling program needs planes. It should -be used after a call to xyzsetup was used to set up two-dimensional -subcubes. The calling program can then loop over all planes (from 1 to -vircubesize(naxis)/vircubesize(2)). xyzplnrd takes care of reading the -datacube. The caveat is that the calling program should have an array -that is large enough to contain the complete plane. -Using this routine instead of xyzs2c and xyzread reduces the overhead -by 1% (for 64**2 cubes) or less. - - Input: - tno image file handle - planenr plane nr to be read from virtual-cube - Output: - plane will contain the plane as a 1-d array - mask FALSE values indicate undefined pixels - ndata number of elements read */ -/*--*/ - -void xyzplnrd_c(int tno, int planenr, float *data, int *mask, int *ndata) -{ - long virpix_off; -#ifdef XYZ_DEBUG - if(otest) xyzs2c_c( tno, planenr-1, tcoo ); -#endif - virpix_off = (planenr-1) * bufs[tno].cubesize[2]; - MODE=GET; get_put_data( tno, virpix_off, data, mask, ndata, 2 ); -} -/******************************************************************************/ -/** xyzwrite - Write arbitrary subcube */ -/*& bpw */ -/*: image-i/o */ -/*+ - subroutine xyzwrite( tno, coords, data, mask, ndata ) - integer tno - integer coords(*) - real data(*) - logical mask(*) - integer ndata - -This routine, xyzsetup and xyzs2c work together to allow writing an -arbitrary subcube in a n-dimensional datacube. xyzwrite writes a subcube -to the datacube, as defined by xyzsetup at coordinates calculated by -xyzs2c. - -The array coords gives the coordinates of the axes complementary to -the subcube axes. E.g., if 'subcube' in the call to xyzsetup was 'y' -and the datacube is 3-dimensional, coords(1) and coords(2) give the -'x' and 'z' coordinate of the requested line profile, respectively. Or, -if 'subcube' was 'xz', coords(1) gives the 'y'-coordinate of the plane. -For a datacube of dimension 'd', only the first 'd - dimsub' elements -of the array coords will be used (where 'dimsub' is the dimension of the -subcube). - -The array data (of dimension ndata) holds the information to be written. -If the subcube was 0-dimensional, the first element of data is written. -For a 1-d subcube a profile is written. The first vircubesize(1) (as -returned by xyzsetup) elements of data are used. For a 2-d subcube the -array data gives the requested plane, as a 1-d array of length -vircubesize(2). Etc. - -The mask array indicates if pixels in the data array must be set to -"undefined". A TRUE value means the data is OK, FALSE means it is -undefined. Element 1 corresponds to data 1, etc. -(this is not yet implemented, so ignored) - -N.B.: to write a datacube pixel by pixel it is more efficient to use -subroutine xyzpixwr instead of xyzwrite, as the conversion from -offset to coordinates to offset that xyzs2c and xyzwrite do then is -superfluous and time-consuming. - - Input: - tno image file handle - coords array of which the first (dim cube)-(dim subcube) - elements are used, giving the coordinate values - along the complementary axes - data array containing data to be written - mask FALSE values indicate undefined pixel - ndata number of elements to write */ -/*--*/ - -void xyzwrite_c(int tno, Const int *coords, Const float *data, - Const int *mask, Const int *ndata ) -{ -/* The calculation first needs the pixeloffset of the input coordinate. - For the varying axes the pixelnumber is 0, for the fixed axes of the - subcube, the pixelnumber is the input minus the lower left offset. - The input array had the first fixed coordinate as element 0, so a - shift of -1 is necessary. After finding the pixelnumber in the - virtual cube get_put_data is used. -*/ - long virpix_off; - int dim_sub, naxes; - dim_sub = dimsub[tno]; - naxes = bufs[tno].naxis; - virpix_off = 0; - dim = dim_sub+1; - while( dim <= naxes ) { - virpix_off += bufs[tno].cubesize[dim-1] * - ( coords[dim-dim_sub-1]-1 - imgs[tno].blc[ axnum[tno][dim] ] ); - dim++; } - MODE=PUT; - get_put_data( tno, virpix_off, (float *)data, (int *)mask, (int *)ndata, dim_sub ); -} -/******************************************************************************/ -/** xyzpixwr - Write a pixel to a dataset */ -/*& bpw */ -/*: image-i/o */ -/*+ - subroutine xyzpixwr( tno, pixelnr, value, mask ) - integer tno - integer pixelnr - real value - logical mask - -This routine provides a faster version of calls to xyzs2c and xyzwrite -for the case that the calling program provides single pixels. It should -be used after a call to xyzsetup was used to set up zero-dimensional -subcubes. The calling program can then loop over all pixels (from 1 to -vircubesize(naxis)). xyzpixwr takes care of writing the datacube. -Using this routine instead of xyzs2c and xyzwrite reduces the overhead -by more than a factor 10. - - Input: - tno image file handle - pixelnr pixelnr to be read from virtual cube - value pixel value - mask FALSE indicates pixel is undefined */ -/*--*/ - -void xyzpixwr_c(int tno, long pixelnr, Const float *data, Const int *mask ) -{ - long virpix_off; -#ifdef XYZ_DEBUG - if(otest) xyzs2c_c( tno, pixelnr-1, tcoo ); -#endif - virpix_off = pixelnr - 1; - if( virpix_off < bufs[tno].filfir || virpix_off > bufs[tno].fillas ) { - MODE=PUT; manage_buffer( tno, virpix_off ); - } - *( buffer + bufs[tno].bufstart + virpix_off ) = *data; - *( mbuffr + bufs[tno].bufstart + virpix_off ) = *mask; - written[tno] = TRUE; -#ifdef XYZ_DEBUG - if(otest) testprint( tno, virpix_off, virpix_off ); -#endif -} -/******************************************************************************/ -/** xyzprfwr - Write a profile to a dataset */ -/*& bpw */ -/*: image-i/o */ -/*+ - subroutine xyzprfwr( tno, profilenr, profile, mask, ndata ) - integer tno - integer profilenr - real profile(*) - logical mask(*) - integer ndata - -This routine provides a (little) faster version for calls to xyzs2c and -xyzwrite for the case that the calling program provides profiles. It -should be used after a call to xyzsetup was used to set up 1-dimensional -subcubes. The calling program can then loop over all profiles (from 1 to -vircubesize(naxis)/vircubesize(1)). xyzprfwr takes care of writing the -datacube. Using this routine instead of xyzs2c and xyzwrite reduces the -overhead by 10% (for 256-long profiles) to 30% (for 64-long profiles). - - Input: - tno image file handle - profilenr profile nr to be read from virtual cube - profile contains the profile to be written - mask FALSE values indicate undefined pixels - ndata number of elements to write */ -/*--*/ - -void xyzprfwr_c(int tno, int profilenr, Const float *data, - Const int *mask, Const int *ndata ) -{ - long virpix_off; -#ifdef XYZ_DEBUG - if(otest) xyzs2c_c( tno, profilenr-1, tcoo ); -#endif - virpix_off = (profilenr-1) * bufs[tno].cubesize[1]; - MODE=PUT; - get_put_data( tno, virpix_off, (float *)data, (int *)mask, (int *)ndata, 1 ); - written[tno] = TRUE; -} -/******************************************************************************/ -/** xyzplnwr - Write a plane to a dataset */ -/*& bpw */ -/*: image-i/o */ -/*+ - subroutine xyzplnwr( tno, planenr, plane, mask, ndata ) - integer tno - integer planenr - real plane(*) - logical mask(*) - integer ndata - -This routine provides a more convenient version of calls to xyzs2c and -xyzwrite for the case that the calling program provides planes. It -should be used after a call to xyzsetup was used to set up 2-dimensional -subcubes. The calling program can then loop over all planes (from 1 to -vircubesize(naxis)/vircubesize(2)). xyzplnwr takes care of writing the -datacube. The caveat is that the calling program should have an array -that is large enough to contain the complete plane. -Using this routine instead of xyzs2c and xyzwrite reduces the overhead -by 1% (for 64**2 cubes) or less. - - Input: - tno image file handle - planenr plane nr to be read from virtual-cube - plane contains the plane to be written as a 1-d array - mask FALSE values indicate undefined pixels - ndata number of elements to write */ -/*--*/ - -void xyzplnwr_c(int tno, int planenr, Const float *data, - Const int *mask, Const int *ndata ) -{ - long virpix_off; -#ifdef XYZ_DEBUG - if(otest) xyzs2c_c( tno, planenr-1, tcoo ); -#endif - virpix_off = (planenr-1) * bufs[tno].cubesize[2]; - MODE=PUT; - get_put_data( tno, virpix_off, (float *)data, (int *)mask, (int *)ndata, 2 ); - written[tno] = TRUE; -} -/******************************************************************************/ -/* */ -/* The routine that figures out if i-o must be done */ -/* */ -/******************************************************************************/ - -static void get_put_data( int tno, long virpix_off, float *data, int *mask, int *ndata, int dim_sub ) -{ -/* This checks if the needed subcube is in the buffer. If so, a piece - of the buffer is copied. If not, manage_buffer is called to fill or - empty the buffer and then the copy is done. -*/ - long virpix_lst; - float *bufptr, *bufend, *bufsta; - int i, coo[ARRSIZ], next; - - - virpix_lst = virpix_off + bufs[tno].cubesize[dim_sub] - 1; - if( MODE==GET ) *ndata = bufs[tno].cubesize[dim_sub]; - if( MODE==PUT && *ndata < bufs[tno].cubesize[dim_sub] ) { - bug_c( 'f', "xyzio: Input array too small to hold subcube" ); - } - if( virpix_off < bufs[tno].filfir || virpix_lst > bufs[tno].fillas ) { - if(itest)printf("\nNew buffer starts at %ld MODE %d\n",virpix_off,MODE); - if( virpix_off >= bufs[tno].cubesize[bufs[tno].naxis] ) bug_c( 'f', - "xyzio: Caller tries to access pixel outside datacube"); - if( dimsub[tno] == -1 ) bug_c( 'f', - "xyzio: xyzsetup was never called for dataset" ); - manage_buffer( tno, virpix_off ); - } - -/* Plain copy */ - if( !reverse[tno][0] ) { - bufptr = buffer + bufs[tno].bufstart + virpix_off; - bufend = buffer + bufs[tno].bufstart + virpix_lst; - do_copy( bufptr, bufend, UP, data, mask ); -/* Reverse copy */ - } else if( reverse[tno][0] == ALL ) { - bufptr = buffer + bufs[tno].bufstart + virpix_lst; - bufend = buffer + bufs[tno].bufstart + virpix_off; - do_copy( bufptr, bufend, DOWN, data, mask ); -/* Some axes reversed */ - } else { - copy_to_one_d( tno ); -/* Apply a trick to avoid a very strange error on the Cray */ -/* bufsta = buffer + bufs[tno].bufstart + virpix_off; */ - i = bufs[tno].bufstart + virpix_off; - for( d=1; d<=dim_sub; d++ ) { - if( !reverses[d] ) coo[d] = 0; else coo[d] = bufsaxlen[d] - 1; -/* bufsta += coo[d] * bufscubesize[d-1]; } */ - i += coo[d] * bufscubesize[d-1]; } bufsta = buffer + i; - for( i=1; i<=bufscubesize[dim_sub]/bufscubesize[1]; i++ ) { - if( !reverses[1] ) { - bufptr = bufsta; - bufend = bufsta + bufsaxlen[1] - 1; - do_copy( bufptr, bufend, UP, data, mask ); - } else { - bufptr = bufsta; - bufend = bufsta - bufsaxlen[1] + 1; - do_copy( bufptr, bufend, DOWN, data, mask ); - } - data += bufsaxlen[1]; mask += bufsaxlen[1]; - next=TRUE; d=2; while( d<=dim_sub && next ) { - if( !reverses[d] ) { - coo[d]++; bufsta += bufscubesize[d-1]; - next = ( coo[d] == bufsaxlen[d] ); - if(next) {coo[d]=0; bufsta -= bufscubesize[d];} - } else { - coo[d]--; bufsta -= bufscubesize[d-1]; - next = ( coo[d] == -1 ); - if(next) {coo[d]=bufsaxlen[d]-1; bufsta += bufscubesize[d];} - } - } - } - } -#ifdef XYZ_DEBUG - if(otest) testprint( tno, virpix_off, virpix_lst ); -#endif -} -/******************************************************************************/ -static void do_copy( float *bufptr, float *bufend, int DIR, float *data, int *mask ) -{ - int *mbufpt; - - mbufpt = mbuffr + (int)(bufptr-buffer); - - if( DIR == UP ) { - if( MODE==GET ) { - while( bufptr<=bufend ) { *data++ = *bufptr++; *mask++ = *mbufpt++; }} - if( MODE==PUT ) { - while( bufptr<=bufend ) { *bufptr++ = *data++; *mbufpt++ = *mask++; }} - } else if( DIR == DOWN ) { - if( MODE==GET ) { - while( bufptr>=bufend ) { *data++ = *bufptr--; *mask++ = *mbufpt--; }} - if( MODE==PUT ) { - while( bufptr>=bufend ) { *bufptr-- = *data++; *mbufpt-- = *mask++; }} - } -} -/******************************************************************************/ -/* */ -/* Buffer control, figures out how to call loop_buffer */ -/* */ -/******************************************************************************/ -static void manage_buffer( int tno, long virpix_off ) -{ -/* This controls the buffer. It tries to do the absolute minimum number - of disk-i/o's, using the array buffer, whose total length is determined - by get_buflen xyzsetup. The array divided into sections, each - corresponding to a particular opened image dataset. The first section is - used to collect data read in or to write. The size of the sections varies - with the number of opened datasets and is xyziobuflen/(nopened+1). When - elements are copied from or to the buffer, they come form or go into the - appropriate section. If a request is made for a pixel outside the section, - manage_buffer is called and the parameters of the section will change. - manage_buffer takes care that all elements of the image section are - read/written. Disk-i/o uses the first section. After reading into it, - each pixel is checked and if it is in range it is copied to the - appropriate element in the section corresponding to the image. The - reading and checking is repeated until the whole section is filled. - For writing, all pixels in the first section are checked and the ones - that are the range of the section for the image, are copied to the first - section. This is continued until all elements in the image-section - have been written. A special case occurs when the subcube specification - was such that no transposition or region was given. Then the read/write - is done directly to the image section, and the loops are skipped. - - There is one extra stage for the case where reading and writing is done - to the same dataset. If a new read is done, the old buffer is first - flushed, if it was ever written into. - - copy_to_one_d makes 1-d arrays of some arrays, to reduce the number - of pointer calculations and to improve code-readability. - - For reading data, some buffer parameters are obtained first, then - the buffer is filled. For writing, the current buffer is first - flushed and then the buffer parameters are set up for the next - buffer. - - set_bufs_limits figures out the virtual-cube pixeloffsets of the - first and last element in the buffer and the range in x, y, z etc - in the virtual-cube buffer and the input/output cube. This allows - shortcuts to be taken. - Further it defines bufs[tno].bufstart, which gives the first element - in the buffer corresponding to this image. Before leaving manage_buffer - this is changed into a number that can be used to convert a virpix_off - to a bufferelement. So, inside this routine bufs[tno].bufstart points - to the buffer, outside it points to the buffer index of the first - element of the virtual-cube. - - For output writing, on the very first pass the buffer was still - empty, not full, so all that is done is to initialize it. Only at - the second and all later passes is it written to disk. - - After all this the first and last pixel of the virtual cube are - converted to the corresponding offsets in the input cube. All - required pixels lie within that range. - - Then a loop is done over all pixels in the input/output buffer and - elements of the virtual cube are copied. This is done in stages, as - the full range of input/output pixels may be larger than the size - of the buffer. So, in each stage a range from start to last is - searched, until the finish is reached. Sometimes it is not necessary - to really do the i/o, so then it is skipped. -*/ - if( MODE==GET && written[tno] ) { - if(itest) printf("Flush previous output buffer\n"); - MODE=PUT; manage_the_buffer( tno, -1 ); MODE=GET; - if(itest) printf("Set up new input buffer\n"); - } - manage_the_buffer( tno, virpix_off ); -} - -static void manage_the_buffer( int tno, long virpix_off ) -{ - long start, finis, newstart, last; - - if( allocatebuffer ) get_buflen(); - - copy_to_one_d( tno ); - - if( imgs[tno].lastwritten == -1 ) zero( 1, tno ); - - if( MODE==GET ) { - set_bufs_limits( tno, virpix_off ); - written[tno] = FALSE; - } - if( MODE==PUT ) { - if( bufs[tno].filfir == -1 ) { - set_bufs_limits( tno, virpix_off ); - bufs[tno].bufstart = - bufs[tno].filfir + bufs[tno].bufstart; - return; - } - bufs[tno].bufstart = bufs[tno].bufstart + bufs[tno].filfir; - if(otest) printf("\n"); - } - - start = transform_back( bufs[tno].filfir ); - finis = transform_back( bufs[tno].fillas ); - if(itest) printf( "%s %ld values: from %ld to %ld\n", - words[MODE], finis-start+1, start, finis ); - - if(itest||rtest){nfound=0;if(imgs[tno].nocopy)nfound=finis-start+1;} - while( start <= finis ) { - last = get_last( start, finis ); - if( check_do_io( tno, start, last ) ) { - if( MODE==GET ) { - fill_buffer( tno, start, last ); - loop_buffer( tno, start, last, &newstart ); - } - if( MODE==PUT ) { - loop_buffer( tno, start, last, &newstart ); - empty_buffer( tno, start, last ); - } - } else { - if(itest) printf( "Did not %s %ld values: from %ld to %ld\n", - words[MODE], last-start+1, start, last ); - } - start = newstart; - } - if(itest) printf( "virbuffer %s\n", words[MODE+2] ); - if( MODE==PUT ) set_bufs_limits( tno, virpix_off ); - bufs[tno].bufstart = - bufs[tno].filfir + bufs[tno].bufstart; -} -/******************************************************************************/ -/* */ -/* Find the length of a buffer that fits in memory */ -/* */ -/******************************************************************************/ -static void get_buflen(void) -{ - int tno; - long try, maxsize, size, cnt; - int *mbufpt; - if(itest)printf("# bytes per real: %ld\n",sizeof(float)); - - maxsize = 0; - for( tno=0; tno<MAXOPEN; tno++ ) { - if( imgs[tno].itno != 0 ) { - size = bufs[tno].cubesize[bufs[tno].naxis]; - maxsize = ( (maxsize<size) ? size : maxsize ); - if(itest)bugv_c( 'i', "xyzsetup: tno=%d naxis=%d size=%d maxsize=%d", - tno, bufs[tno].naxis, size, maxsize); - } - } - try = (ntno+1) * maxsize; - if(itest)bugv_c( 'i', "xyzsetup: try=%ld ntno=%d maxsize=%ld",try,ntno,maxsize); - if( (buffer==NULL) || (try>currentallocation) ) try = bufferallocation(try); - allocatebuffer = FALSE; - - buffersize = try / (ntno+1); - - for( tno=0; tno<MAXOPEN; tno++ ) { - if( imgs[tno].itno != 0 ) { - if( bufs[tno].cubesize[dimsub[tno]] > buffersize ) { - bugv_c( 'i', "xyzsetup: tno=%d itno=%d dimsub[tno]=%d",tno,imgs[tno].itno,dimsub[tno]); - bugv_c( 'f', "xyzsetup: Requested subcube too big for buffer (%ld > %ld)", - bufs[tno].cubesize[dimsub[tno]] ,buffersize); - } - } - } - - /* set combined masking buffer to true, just in case no real mask is read in */ - mbufpt = mbuffr; cnt=0; - while( cnt++ < try ) *mbufpt++ = FORT_TRUE; -} - -static long bufferallocation( long n ) -{ - long n0 = n; -#if 0 - long maxbuf = MAXBUF; -#else - long maxbuf = n; -#endif - if (n > MAXBUF) bugv_c( 'i',"xyzsetup: Trying to allocate %ld pixels but MAXBUF=%d", n,MAXBUF); - if(itest)printf("Trying to allocate %ld (maxbuf=%ld MAXBUF=%d)\n",n,maxbuf,MAXBUF); - - if( buffer != NULL ) { free( buffer ); buffer = NULL; } - if( mbuffr != NULL ) { free( mbuffr ); mbuffr = NULL; } - - n = ( (n < maxbuf) ? n : maxbuf ); - n *= 2; - while( ( (buffer == NULL) || (mbuffr == NULL) ) && (n>1) ) { - if( buffer != NULL ) { free( buffer ); buffer = NULL; } - if( mbuffr != NULL ) { free( mbuffr ); mbuffr = NULL; } - n /= 2; - if(itest)printf("try %ld\n",n); - buffer = (float *)malloc(n*sizeof(float)); - mbuffr = (int *)malloc(n*sizeof(int)); - } - if( n == 1 ) bugv_c( 'f', "xyzsetup: Failed to allocate memory for %ld pixels", n0 ); - - if(itest)printf("Allocated %ld reals @ %p\n",n,(Void *)buffer); - if(itest)printf("Allocated %ld ints @ %p\n",n,(Void *)mbuffr); - - currentallocation = n; - return n; -} -/******************************************************************************/ -static void copy_to_one_d( int tno ) -{ -/* All this does is make one-d arrays of some 2-d arrays, so that the - number of pointer calculations is reduced. And also it makes the - routines below manage_buffer more readable. -*/ - naxes = bufs[tno].naxis; - for( d=0; d<=naxes; d++ ) { - imgsaxlen[d] =imgs[tno].axlen[d]; bufsaxlen[d] =bufs[tno].axlen[d]; - imgscubesize[d]=imgs[tno].cubesize[d];bufscubesize[d]=bufs[tno].cubesize[d]; - imgsblc[d] =imgs[tno].blc[d]; bufsblc[d] =0; - imgstrc[d] =imgs[tno].trc[d]; bufstrc[d] =bufs[tno].axlen[d]-1; - imgscsz[d] =imgscubesize[d-1]; bufscsz[d] =bufscubesize[d-1]; - imgslower[d] =imgs[tno].lower[d]; - imgsupper[d] =imgs[tno].upper[d]; - axnumr[d] =axnum[tno][d]; - reverses[d] =reverse[tno][d]; - } - for( d=1; d<=naxes; d++ ) inv_axnumr[ axnumr[d] ] = d; -} - -static void set_bufs_limits( int tno, long virpix_off ) -{ -/* This gets some information about the virtual-cube buffer and the ranges - of coordinates. - First it figures out which range of pixeloffsets from the virtual cube - fits in the buffer (from bufs[tno].filfir to bufs[tno].fillas). - bufs[tno].fillas is found by figuring out what the pixeloffset of the - last complete subcube was. It is limited by the size of the virtual cube. - It also finds a pointer to the element in the buffer that will - correspond to the first element of the virtual cube that is present - (bufs[tno].bufstart). - Next it finds the lower and upper limits that will ever be found for - each coordinate: bufs.lower and bufs.upper. This is used later to limit - the number of transformations by skipping over ranges where no buffer - pixels will be found. Its main use is to be able to take shortcuts, to - reduce the overhead. -*/ - if( virpix_off == -1 ) return; - - bufs[tno].filfir = virpix_off; - bufs[tno].bufstart = imgs[tno].number*buffersize; - bufs[tno].fillas = - (long)( (bufs[tno].filfir+buffersize) / bufscubesize[dimsub[tno]] ) - * bufscubesize[dimsub[tno]] - 1; - if( bufs[tno].fillas > bufscubesize[ naxes ] - 1 ) - bufs[tno].fillas = bufscubesize[ naxes ] - 1; - - find_block( bufs[tno].filfir, bufs[tno].fillas, - bufs[tno].lower, bufs[tno].upper, - bufsaxlen, bufscubesize, bufsblc, bufstrc, naxes ); - for( dim=1; dim<=naxes; dim++ ) { - imgs[tno].lower[axnumr[dim]]=bufs[tno].lower[dim]+imgsblc[axnumr[dim]]; - imgs[tno].upper[axnumr[dim]]=bufs[tno].upper[dim]+imgsblc[axnumr[dim]]; - } - for( dim=1; dim<=naxes; dim++ ) { - imgslower[dim] = imgs[tno].lower[dim]; - imgsupper[dim] = imgs[tno].upper[dim]; - } - - if(itest) { printf( "fill %s buffer; will be full after %ld pixels\n", - words[MODE], bufs[tno].fillas - bufs[tno].filfir + 1 ); - limprint( "vircub", bufs[tno].lower, bufs[tno].upper ); } -} - -static long get_last( long start, long finis ) -{ -/* This routine figures out how many elements will fit into the buffer: - the lower of the amount needed and the size of the buffer. It returns - the fileoffset of the last element that fits. -*/ - long allocate; - if( finis-start+1 > buffersize ) { allocate = buffersize; } - else { allocate = finis-start+1; } - return( start + allocate - 1 ); -} - -static int check_do_io( int tno, long start, long last ) -{ -/* - This routine checks if it is really necessary to read or write data - from/to disk. - It calculates the lowest and highest coordinate value that will ever - be encountered. A comparison is done with the lowest and highest that - might go into the buffer. If at least part of "the subcube selected - from the inputcube" and "the subcube from the virtual cube that will - fit into the buffer" overlap, a disk-i/o is required, as there will be - at least one element of the virtual-cube-buffer read or written. This - mainly comes into play when the buffer is smaller than an image plane - and z-profiles must be read/written. -*/ - int imgslow[ARRSIZ], imgsupp[ARRSIZ]; - int do_io; - - find_block( start, last, imgslow, imgsupp, - imgsaxlen, imgscubesize, imgsblc, imgstrc, naxes ); - do_io = FALSE; - for( dim=1; dim<=naxes && !do_io; dim++ ) { - do_io = ( bufs[tno].lower[ dim ] <= imgsupp[ axnumr[dim] ] ) || - ( bufs[tno].upper[ dim ] >= imgslow[ axnumr[dim] ] ); - } - if(itest) limprint( "i-ocub", imgslow, imgsupp ); - return do_io; -} - -static void find_block( long start, long last, int *lower, int *upper, - int *axlen, long *cubesize, int *blc, int *trc, int naxis ) -{ -/* Figures out from the first and last pixeloffset what the lowest and - highest coordinate value are that could possibly be encountered. To do - this it calculates the first coordinate value in the 'plane' (e.g. how - many lines fit into z*(#lines/plane) and subtracts this from the - non-modulo calculated coordinate value of the last pixeloffset. Then - it checks if the next 'plane' was reached. If not, the coordinate - limits are determined by the coordinate values themselves, else they - are the lower/upper ends of the ranges. -*/ - int bot, top; - int strcoo[ARRSIZ], fincoo[ARRSIZ]; - p2c( start, axlen, cubesize, naxis, strcoo ); - p2c( last, axlen, cubesize, naxis, fincoo ); - for( dim=1; dim<=naxis; dim++ ) { - bot = (int)( start / cubesize[dim] ) * axlen[dim]; - top = (int)( last / cubesize[dim-1] ) - bot; - ( ( top > trc[dim] ) ? ( lower[dim] = blc[dim] ) - : ( lower[dim] = strcoo[dim] ) ); - ( ( top >= trc[dim] ) ? ( upper[dim] = trc[dim] ) - : ( upper[dim] = fincoo[dim] ) ); - } -} - -static long transform_back( long pix_off ) -{ -/* Transforms an virtual-cube pixeloffset into an input pixeloffset. -*/ - int inpcoo, vircoo, axnr; - long result; - result = 0; - for( dim=1; dim<=naxes; dim++ ) { - axnr = axnumr[dim]; - vircoo = ( pix_off / bufscubesize[ dim-1 ] ) % bufsaxlen[ dim ]; - inpcoo = vircoo + imgsblc[ axnr ]; - result += imgscubesize[axnr-1] * inpcoo; - } - return ( result ); -} - -static long c2p( int *coords, long *cubesize, int naxis ) -{ -/* Converts a list of coordinates into a pixeloffset -*/ - long pix_off; pix_off=0; - for( d=1; d<=naxis; d++ ) pix_off += cubesize[d-1] * coords[d]; - return ( pix_off ); -} -static void p2c( long pix_off, int *axlen, long *cubesize, int naxis, int *coords ) -{ -/* Converts a pixeloffset into a list of coordinates -*/ - for( d=1; d<=naxis; d++ ) coords[d] = ( pix_off/cubesize[d-1] ) % axlen[d]; -} - -/******************************************************************************/ -/* */ -/* The routines that do the i-o */ -/* */ -/******************************************************************************/ - -static void fill_buffer( int tno, long start, long last ) -{ - long length; - long begin,i; - int bufstart, *buf; - int iostat; - - nio++; - if(itest) printf( "Read %ld values: %ld to %ld\n", last-start+1, start, last ); - - if( !imgs[tno].nocopy ) bufstart=0; else bufstart=bufs[tno].bufstart; - length = H_REAL_SIZE * ( last - start + 1 ); - begin = H_REAL_SIZE * start + ITEM_HDR_SIZE; -/* hgrab_c( imgs[tno].itno,(char *)(buffer+bufstart),begin,length,&iostat );*/ - hreadr_c( imgs[tno].itno,(char *)(buffer+bufstart),begin,length,&iostat ); - check(iostat); - length = last - start + 1; - begin = start; - if( imgs[tno].mask ) { - mkread_c( imgs[tno].mask,1,mbuffr+bufstart,begin,length,length ); - } else { - buf = mbuffr+bufstart; - for (i=0; i<length; i++) - buf[i] = FORT_TRUE; - } - - if(vtest){ for( i=0; i<last-start+1; i++ ) { - p2c( i+start, imgsaxlen, imgscubesize, naxes, tcoo ); - *(buffer+i) = (float)( tcoo[1] + 1000*tcoo[2] + 1000000*tcoo[3] ); }} -} - -static void empty_buffer( int tno, long start, long last ) -{ - long length; - long begin; - int bufstart; - int iostat; - - nio++; - if(itest) printf( "Write %ld values: %ld to %ld\n", last-start+1,start,last ); - - if( !imgs[tno].nocopy ) bufstart=0; else bufstart=bufs[tno].bufstart; - length = H_REAL_SIZE * ( last - start + 1 ); - begin = H_REAL_SIZE * start + ITEM_HDR_SIZE; -/* hdump_c( imgs[tno].itno,(char *)(buffer+bufstart),begin,length,&iostat );*/ - hwriter_c(imgs[tno].itno,(char *)(buffer+bufstart),begin,length,&iostat ); - if( imgs[tno].lastwritten < last ) imgs[tno].lastwritten = last; - check(iostat); - if( imgs[tno].mask ) { - length = last - start + 1; - begin = start; - mkwrite_c( imgs[tno].mask,1,mbuffr+bufstart,begin,length,length); - } - -} -/******************************************************************************/ -/* */ -/* Copy from the i-o buffer to the xyzio-buffer, the core of the routine */ -/* */ -/******************************************************************************/ -static void loop_buffer( int tno, long start, long last, long *newstart ) -{ -/* This routine checks all pixels in the in/out buffer and puts them at - the appropriate place in the virtual-cube buffer, or it takes them out - of the virtual-cube buffer. - In principle, for each pixel the input/output-pixeloffset is converted - into a virtual-pixeloffset and this is checked against the range of - elements in the virtual-cube buffer. For efficiency the conversion is - not done explicitly. What is done is to loop over the x-coordinate of - the in/out buffer and increment x, the pointer to the x-axis of the - in/out buffer, and the virtual-cube offset until x flows over its - maximum. This limits the number of operations in the innermost loop to - only 11. Meanwhile the virtual-cube-offset is checked and data is - copied as found. If x flowed over, the coordinates are recalculated - and x is set to its lower limit. The other coordinates are either - increased by one or, if they reached their upper limit, set to their - lower limit. This allows for shortcuts to be taken if a region was - specified and does not give a substantial overhead if no region was - specified. From the new coordinates the pointer to the in/out buffer - (bufptr) and virtual-cube-buffer (bufoff) are recalculated. All this - continues until the in/out buffer is exhausted. - Before starting to work on filling a buffer to write, a check is made - whether is is necessary to set all elements to zero (if the output - region is smaller than the output cube and the output cube did not - yet exist) or to put the old values in the buffer (if the output cube - existed and a transposition or region-selection was done). - The speed of this algorithm is the limiting factor in the speed of - filling/emptying buffers. Even more so than the size of the buffers. - So anyone who can come up with a faster method of doing the same - (transposing cubes) will be able to improve efficiency. -*/ - int buffir, buflas, bufoff; - float *bufptr, *bufend; - int *mbufpt; - int to_in; - long filoff; - int coords[ARRSIZ]; - - *newstart = last + 1; - if( imgs[tno].nocopy ) return; - - buffir = bufs[tno].bufstart; - buflas = bufs[tno].fillas - bufs[tno].filfir + buffir; - - bufptr = buffer; - bufend = buffer + last - start; - mbufpt = mbuffr; - - if( MODE==PUT ) { - if( imgs[tno].lastwritten <= last ) { - if( imgs[tno].lastwritten >= start ) { - fill_buffer( tno, start, imgs[tno].lastwritten ); - bufptr = buffer + imgs[tno].lastwritten - start + 1; - mbufpt = mbuffr + imgs[tno].lastwritten - start + 1; - } - if(itest) printf("zero buffer 0\n"); - while( bufptr <= bufend ) { *bufptr++ = 0; *mbufpt++ = FORT_TRUE; } - } else { - fill_buffer( tno, start, last ); - } - bufptr = buffer; - mbufpt = mbuffr; - } - - p2c( start, imgsaxlen, imgscubesize, naxes, coords ); - bufoff = -bufs[tno].filfir + bufs[tno].bufstart; - for( d=1; d<=naxes; d++ ) - bufoff += bufscsz[inv_axnumr[d]] * ( coords[d] - imgsblc[d] ); - - to_in = ( MODE==GET ); - - while( bufptr <= bufend ) { - if( coords[1] <= imgsupper[1] ) { -#ifdef XYZ_DEBUG - if(rtest)testsearch(1,coords,start+bufptr-buffer,bufoff-buffir); -#endif - if( buffir <= bufoff && bufoff <= buflas ) { - if( to_in ) { *(buffer+bufoff) = *bufptr; - *(mbuffr+bufoff) = *mbufpt; } - else { *bufptr = *(buffer+bufoff); - *mbufpt = *(mbuffr+bufoff); } -#ifdef XYZ_DEBUG - if(itest||rtest)nfound++; - if(rtest) - printf(" found element %d; value %f %d",bufoff,*bufptr,*mbufpt); -#endif - } -#ifdef XYZ_DEBUG - if(rtest) printf("\n"); -#endif - coords[1]++; - bufoff += bufscsz[inv_axnumr[1]]; - bufptr++; mbufpt++; - } - if( coords[1] > imgsupper[1] ) { -#ifdef XYZ_DEBUG - if(rtest) testsearch(0,coords,0,0); -#endif - coords[1] = imgslower[1]; - d=2; while( d<=naxes ) { - if( coords[d] == imgsupper[d] || coords[d] == imgstrc[d] ) - { coords[d] = imgslower[d]; } - else { coords[d]++; break; } - d++; - } - if( d > naxes ) break; -#ifdef XYZ_DEBUG - if(rtest) testsearch(2,coords,0,0); -#endif - filoff = -start; - bufoff = -bufs[tno].filfir + bufs[tno].bufstart; - for( d=1; d<=naxes; d++ ) { - filoff += imgscsz[d] * coords[d]; - bufoff += bufscsz[inv_axnumr[d]] * ( coords[d] - imgsblc[d] ); - } - bufptr = buffer + filoff; - mbufpt = mbuffr + filoff; - } - } - if(itest||rtest) printf( "found %d elements\n", nfound ); - *newstart = bufptr - buffer + start; -} - -/******************************************************************************/ - -static void zero( int bl_tr, int tno ) -{ -/* This initializes parts of an output datacube that were not accessed - because the new dataset has a blc and trc inside the full cube. - It is called with bl_tr==1 just before the put buffer is first set up, - and with bl_tr==2 just before the close. -*/ - long start, last, finis; - float *bufptr, *bufend; - int *mbufpt; - - if( bl_tr == 1 ) { - start = 0; - finis = c2p( imgsblc, imgscubesize, naxes ) - 1; - finis = imgscubesize[naxes] - 1; - } else if( bl_tr == 2 ) { - start = c2p( imgstrc, imgscubesize, naxes ) + 1; - finis = imgscubesize[naxes] - 1; - } - while( start <= finis ) { - last = get_last( start, finis ); - bufptr = buffer; - bufend = buffer + last - start; - mbufpt = mbuffr; - if(itest) printf("zero part of buffer 0\n"); - while( bufptr <= bufend ) { *bufptr++ = 0.; *mbufpt++ = FORT_FALSE; } - empty_buffer( tno, start, last ); - start = bufptr - buffer + start; - } -} - -/******************************************************************************/ -/******************************************************************************/ - -static void testprint( int tno, long virpix_off, long virpix_lst ) -{ - int vircoo[ARRSIZ]; - long inpix_off; - int naxes; - naxes=imgs[tno].naxis; - p2c( virpix_off, bufs[tno].axlen, bufs[tno].cubesize, naxes, vircoo ); - for( dim=1; dim<=naxes; dim++ ) - tcoo[dim] = vircoo[ inv_axnumr[dim] ] + imgs[tno].blc[dim]; - inpix_off = c2p( tcoo, imgs[tno].cubesize, naxes ); - printf( "coo: " ); - for( dim=1; dim<=naxes; dim++) printf( "%4d ", tcoo[dim] ); - printf( " offset: %10ld\n", inpix_off ); - printf( "vircoo: " ); - for( dim=1; dim<=naxes; dim++) printf( "%4d ", vircoo[dim] ); - printf( " offset: %20ld\n", virpix_off ); - if( virpix_off == virpix_lst ) { - printf( "%s copied element %ld\n", words[MODE], - virpix_off+bufs[tno].bufstart ); - } else { - printf( "%s copied %ld elements starting at %ld\n", words[MODE], - virpix_lst-virpix_off+1, virpix_off+bufs[tno].bufstart ); - } -} - -static void limprint( char *string, int *lower, int *upper ) -{ - printf( "%s:", string ); - printf( " lower" ); for( d=1; d<=naxes; d++ ) printf( " %d", lower[d] ); - printf( ": upper" ); for( d=1; d<=naxes; d++ ) printf( " %d", upper[d] ); - printf( "\n"); -} - -static void testsearch( int callnr, int *coords, long filoff, long viroff ) -{ - if( callnr == 2 ) printf( " -> " ); - for( d=1; d<=naxes; d++ ) printf("%d ", coords[d] ); - if( callnr == 1 ) printf( " filoff %ld viroff %ld", filoff, viroff ); - if( callnr == 2 ) printf( "\n" ); -} - - - -/******************************************************************************/ -/******************************************************************************/ -/******************************************************************************/ -/* Text for the userguide */ -/* -To read or write a MIRIAD dataset the following set of routines can be used. - - xyzopen( tno, name, status, naxis, axlen ) - xyzclose( tno ) - xyzsetup( tno, subcube, blc, trc, viraxlen, vircubesize ) - xyzs2c( tno, subcubnr, coords ) - xyzc2s( tno, coords, subcubenr ) - xyzread( tno, coords, data, mask, dimdata ) - xyzpixrd( tno, pixelnr, data, mask ) - xyzprfrd( tno, profinr, data, mask, dimdata ) - xyzplnrd( tno, planenr, data, mask, dimdata ) - xyzwrite( tno, coords, data, mask, dimdata ) - xyzpixwr( tno, pixelnr, data, mask ) - xyzprfwr( tno, profinr, data, mask, dimdata ) - xyzplnwr( tno, planenr, data, mask, dimdata ) - -xyzopen opens the dataset and readies it for reading/writing. 'name' is the -name of the dataset. 'status' can be either "old" or "new", depending on -whether an existing dataset is opened or a new one must be created. For old -datasets naxis gives the dimension of array axlen on input and the dimension -of the dataset on output. On output axlen contains the length of the axes. -For new datasets naxis and axlen specify the number of axes and their length. - -xyzclose closes the dataset. - -The rest of the xyz routines can be used to read or write an arbitrary -subcube in the dataset in a manner that minimizes disk-i/o. To do this, -the datacube axes are named 'x', 'y', 'z', 'a', 'b', etc. 'x' may be RA -or DEC or velocity or anything else, but it is the first axis. - -The xyzsetup subroutine is used to define a subcube in the dataset. There are -many subcubes in a dataset. They have axes with "varying coordinates" and axes -with "fixed coordinates". With n "varying coordinates" the subcube is -n-dimensional, and its position in the original cube is given by the "fixed -coordinates". The subcubes are also ordered, along the "fixed coordinates". -E.g., for profiles in the 'z' direction, the first subcube has (x=1,y=1), the -second has (x=2,y=1), on to (x=axlen(1),y=1) and then (x=1,y=2) etc, etc. - -For datasets that must be read, the 'subcube' variable of xyzsetup specifies -which axes from the original cube have "varying coordinates"; e.g. 'z' for -profiles the z-direction, or 'xy' for image planes. It is also allowed to -transpose axes: e.g. 'zx' (which would usually correspond to making a vel-RA -plane). To understand the meaning of 'subcube' for datasets that must be written -a little explanation is in order: the xyz routines produce a "virtual cube", -one that never actually is written on disk or resides in memory, but which is -conceptually useful. In this virtual cube the axes are ordered such that the -ones with "varying coordinates" become the 'x', 'y' etc axes, and the ones with -"fixed coordinates" form the rest. So, if 'subcube' was 'z', a profile along -the 'x'-axis of the virtual cube contains the datavalues on a profile along the -'z'-axis of the input cube. The 'y' and 'z' axes of the virtual cube were the -'x' and 'y' axes of the original cube, respectively. For writing a dataset, the -'subcube' variable gives the correspondence between the axes of the virtual -cube and the output cube. E.g., if 'subcube' is 'z', this means that the first -('x') axis of the virtual cube is the 'z'-axis of the output cube, and the 'y' -and 'z' axes of the virtual cube correspond to the 'x' and 'y' axes of the -output cube, respectively. - -Preceding an axisname with a '-' results in mirror-imaging the input or output -data for that axis. - -The blc and trc variables of xyzsetup give the bottom left and top right -corner of the part of the image cube to be worked on. The first naxis -elements of blc and trc are used. For reading, this is the region to be read, -for writing it is the region to be written. In the latter case, if the output -dataset did not yet exist and the region is smaller than the total cubesize -given in xyzopen, the outside-region is automatically set to zero. - -The viraxlen and vircubesize variables of xyzsetup give some information -about the virtual cube: the axis lengths and the 'cubesizes'. 'cubesize(1)' is -the number of pixels in a profile, 'cubesize(2)' is the number of pixels in a -plane, 'cubesize(3)' is the number of pixels in a cube, etc. So, for a 3-d -input cube, 'cubesize(3)' gives the total number of pixels to work on. - -The subroutine xyzs2c can be used to obtain the values of the "fixed -coordinates" for a given subcube number. The first element of the array coords -then corresponds to the first "fixed coordinate" value, etc. E.g., for profiles -in the 'z'-direction, coords(1) is the 'x'-position, coords(2) the 'y'-position. -Subroutine xyzc2s does the inverse operation. - -xyzread, xyzpixrd, xyzprfrd and xyzplnrd do the actual reading of data. xyzread -takes as input the "fixed coordinate" values and returns the subcube in the -1-dimensional array data. The other 3 routines read a single pixel, a single -profile and a single plane, respectively. In each case the array data (whose -dimension is transferred to the subroutines in the variable dimdata) should be -large enough to hold the entire requested subcube. The logical array mask is -used to indicate if datapixels were undefined (this is not yet implemented). -mask=TRUE means the pixel is OK; FALSE means it is undefined. -The write routine works in the same manner. -If the program wants to loop over pixels or profiles, use of xyzs2c and xyzread -becomes less efficient than use of xyzpixrd or xyzprfrd. In fact, for looping -over pixels, the xyzs2c-xyzread combination is about 10 times less efficient -than xyzpixrd. This is because with xyzs2c and xyzread the pixelnumber is first -converted to a coordinate with xyzs2c and then converted back to a pixelnr in -xyzread, while xyzpixrd avoids this overhead. - -A typical call sequence using the xyz routines to work on profiles in the -z-direction would be: - - call xyzopen( tno1, name1, 'old', naxis, axlen ) - call xyzopen( tno2, name2, 'new', naxis, axlen ) - call headcopy( tno1, tno2, axnum, naxis ) ! axnum(i)=i - call boxinput( 'region', name, boxes, maxboxes ) - call boxinfo( boxes, naxis, blc, trc ) - call xyzsetup( tno1, 'z', blc, trc, viraxlen, vircubesize ) - call xyzsetup( tno2, 'z', blc, trc, viraxlen, vircubesize ) - nprofiles = = vircubesize(naxis) / viraxlen(1) - do profile = 1, nprofiles - call xyzprfrd( tno1, profile, data, mask, dimdata ) - call work_on_profile( data, mask, dimdata ) - call xyzprfwr( tno2, profile, data, mask, dimdata ) - enddo - -A warning is in order: each call to xyzsetup causes all internal buffers to be -lost completely, so xyzsetup should be called for all datasets before starting -to work on them. Output buffers are flushed before the buffers are lost, -however. - -The overhead introduced by the calculations done by the xyz routines is shown -below. These were calculated using a testprogram that was complete but for -actually doing something with the data and reading them from disk. The first -number gives the times when using xyzpixrd, xyzprfrd and xyzplnrd, the second -when using xyzs2c and xyzread. The overhead does not change with changing -buffersize, but the number of disk-i/o's does. In a test using xyzprfrd and -xyzprfwr on a 128^3 cube, with a 4Mb buffer, it took 120s to copy the input -file using these routines, and 80s with a unix cp. With a 2Mb buffer the copy -took 120s too, even though the number of i-o's increased from 12 to 22. - -buffer of 524288 (2Mb): 1/2th of 128^3 cube; 1/16th of 256^3 cube - cubesize 32^3 64^3 128^3 256^3 -pixels time(s) 0.3( 2.6) 1.6( 20.6) 12.4(170.2) 98.2(1396.6) - n_i/o 1 2 13 97 -x profiles time(s) 0.1( 0.2) 0.6( 0.9) 4.2( 5.2) 31.2( 35.5) - n_i/o 1 1 2 16 -y profiles time(s) 0.4( 0.4) 2.2( 2.5) 16.8( 17.9) 129.8(134.0) - n_i/o 1 1 2 16 -z profiles time(s) 0.4( 0.4) 2.4( 2.5) 16.7( 17.7) 129.5(133.7) - n_i/o 1 1 4 256 -xy planes time(s) 0.2( 0.1) 0.6( 0.5) 3.9( 4.0) 30.1( 30.1) - n_i/o 1 1 2 16 -yx planes time(s) 0.4( 0.4) 2.2( 2.2) 16.4( 16.5) 128.6(128.7) - n_i/o 1 1 2 16 -xz planes time(s) 0.3( 0.3) 2.2( 2.1) 16.4( 16.4) 128.4(128.4) - n_i/o 1 1 4 256 -zx planes time(s) 0.3( 0.4) 2.2( 2.2) 16.5( 16.4) 128.2(128.3) - n_i/o 1 1 4 256 -yz planes time(s) 0.4( 0.3) 2.1( 2.2) 16.9( 16.8) 157.4(157.4) - n_i/o 1 1 4 256 -zy planes time(s) 0.4( 0.4) 2.2( 2.1) 16.9( 16.8) 157.4(157.3) - n_i/o 1 1 4 256 - - cubesize 128*128*112 256*256*64 -z profiles time(s) 15.1 34.5 - n_i/o 8 32 - -*/ - - -/* -Number of operations per call to xyz routines, 3-d cube: - -xyzs2c: 82 -xyzr/w: 82+3n -xyzpix: 15 -xyzprf: 36+3n -xyzpln: 36+3n - - pix/prf/pln xyzs2c & read ratio -pixels (15)N^3 (164)N^3 15/164 -profiles (36+3N)N^2 (164+3N)N^2 (36+3N)/(164+3N) -planes (36+3N^2)N (164+3N^2)N (36+3N^2)/(164+3N^2) - - 32^3 64^3 128^3 256^3 512^3 -pixels 0.091 -profiles 0.508 0.640 0.766 0.863 0.925 -planes 0.960 0.990 0.997 0.999 1.000 - -*/ - - -/******************************************************************************/ -/******************************************************************************/ -/******************************************************************************/ - - - - - - Index: casacore-3.5.0/mirlib/README =================================================================== --- casacore-3.5.0.orig/mirlib/README +++ /dev/null @@ -1,54 +0,0 @@ -# README: README file for miriad library. -# Copyright (C) 1993,1994,1995,1997,1999,2001 -# Associated Universities, Inc. Washington DC, USA. -# -# This library is free software; you can redistribute it and/or modify it -# under the terms of the GNU Library General Public License as published by -# the Free Software Foundation; either version 2 of the License, or (at your -# option) any later version. -# -# This library 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 Library General Public -# License for more details. -# -# You should have received a copy of the GNU Library General Public License -# along with this library; if not, write to the Free Software Foundation, -# Inc., 675 Massachusetts Ave, Cambridge, MA 02139, USA. -# -# Correspondence concerning AIPS++ should be addressed as follows: -# Internet email: aips2-request@nrao.edu. -# Postal address: AIPS++ Project Office -# National Radio Astronomy Observatory -# 520 Edgemont Road -# Charlottesville, VA 22903-2475 USA -# - -# $Id$ - -This code is a subset of the MIRIAD I/O library. The MIRIAD package is -a package developed for BIMA and actively being used by BIMA and ATNF -for their offline calibration and data reduction needs. - -More details on the MIRIAD package can be found on: - - http://bima.astro.umd.edu/bima/miriad/ -or http://www.atnf.csiro.au/computing/software/miriad/ - -Although the BIMA and ATNF versions use a slightly different directory -structure (January 1997), the source code is essentially the same. You -should be able to find all subroutines in $MIR/src/subs, except for -miriad.h, which was specifically generated for the AIPS++ project. -MIRIAD V3 (the BIMA version of MIRIAD) has been placed under CVS control, -mirlib is a direct extraction of that release (June 2001). -A new version of this library will be needed to deal with -large (>2GB) files, which is to be extracted from the CARMA version -of MIRIAD (2011). - -Most of the low level C code was developed by Bob Sault -(rsault@atnf.csiro.au). - -Correspondence concerning MIRLIB should be directed to Peter Teuben -(teuben@astro.umd.edu). - - Index: casacore-3.5.0/images/Images/MIRIADImage.cc =================================================================== --- casacore-3.5.0.orig/images/Images/MIRIADImage.cc +++ /dev/null @@ -1,1125 +0,0 @@ -//# MIRIADImage.cc: Class providing native access to MIRIAD images -//# Copyright (C) 2001,2002,2003 -//# Associated Universities, Inc. Washington DC, USA. -//# -//# This library is free software; you can redistribute it and/or modify it -//# under the terms of the GNU Library General Public License as published by -//# the Free Software Foundation; either version 2 of the License, or (at your -//# option) any later version. -//# -//# This library 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 Library General Public -//# License for more details. -//# -//# You should have received a copy of the GNU Library General Public License -//# along with this library; if not, write to the Free Software Foundation, -//# Inc., 675 Massachusetts Ave, Cambridge, MA 02139, USA. -//# -//# Correspondence concerning AIPS++ should be addressed as follows: -//# Internet email: aips2-request@nrao.edu. -//# Postal address: AIPS++ Project Office -//# National Radio Astronomy Observatory -//# 520 Edgemont Road -//# Charlottesville, VA 22903-2475 USA -//# -//# $Id$ - -#include <casacore/images/Images/MIRIADImage.h> - -#include <casacore/images/Images/ImageInfo.h> -#include <casacore/images/Images/MaskSpecifier.h> -#include <casacore/images/Images/ImageOpener.h> -#include <casacore/lattices/Lattices/TiledShape.h> -#include <casacore/lattices/Lattices/TempLattice.h> -#include <casacore/tables/DataMan/TiledFileAccess.h> -#include <casacore/coordinates/Coordinates/CoordinateSystem.h> - -#include <casacore/coordinates/Coordinates/Coordinate.h> -#include <casacore/coordinates/Coordinates/LinearCoordinate.h> -#include <casacore/coordinates/Coordinates/DirectionCoordinate.h> -#include <casacore/coordinates/Coordinates/SpectralCoordinate.h> -#include <casacore/coordinates/Coordinates/TabularCoordinate.h> -#include <casacore/coordinates/Coordinates/StokesCoordinate.h> -#include <casacore/coordinates/Coordinates/Projection.h> - -#include <casacore/casa/Arrays/Array.h> -#include <casacore/casa/Arrays/Matrix.h> -#include <casacore/casa/IO/ArrayIO.h> -#include <casacore/casa/Arrays/IPosition.h> -#include <casacore/casa/Arrays/Slicer.h> -#include <casacore/casa/Containers/Record.h> -#include <casacore/casa/Logging/LogIO.h> -#include <casacore/casa/BasicMath/Math.h> -#include <casacore/casa/OS/File.h> -#include <casacore/casa/Quanta/Unit.h> -#include <casacore/casa/Quanta/UnitMap.h> -#include <casacore/casa/Utilities/CountedPtr.h> -#include <casacore/casa/Utilities/ValType.h> -#include <casacore/casa/Utilities/Regex.h> -#include <casacore/casa/BasicSL/String.h> -#include <casacore/casa/Utilities/Assert.h> -#include <casacore/casa/Exceptions/Error.h> -#include <casacore/fits/FITS/FITSSpectralUtil.h> - -#include <casacore/casa/iostream.h> - -#include <casacore/mirlib/maxdimc.h> -#include <casacore/mirlib/miriad.h> - -namespace casacore { //# NAMESPACE CASACORE - BEGIN - -// set this to 1 or 0 to benchmark tiled access vs. xyio(native miriad) access -#define USE_TILE 1 - -MIRIADImage::MIRIADImage (const String& name) -: ImageInterface<Float>(), - name_p (name), - pPixelMask_p(0), - hasBlanks_p (False), - dataType_p (TpOther), - fileOffset_p(0), - isClosed_p (True) -{ - setup(); -} - -MIRIADImage::MIRIADImage (const String& name, const MaskSpecifier& maskSpec) -: ImageInterface<Float>(), - name_p (name), - maskSpec_p (maskSpec), - pPixelMask_p(0), - hasBlanks_p (False), - dataType_p (TpOther), - fileOffset_p(0), - isClosed_p (True) -{ - setup(); -} - -MIRIADImage::MIRIADImage (const MIRIADImage& other) -: ImageInterface<Float>(other), - name_p (other.name_p), - maskSpec_p (other.maskSpec_p), - unit_p (other.unit_p), - rec_p (other.rec_p), - pTiledFile_p(other.pTiledFile_p), - pPixelMask_p(0), - shape_p (other.shape_p), - hasBlanks_p (other.hasBlanks_p), - dataType_p (other.dataType_p), - fileOffset_p(other.fileOffset_p), - isClosed_p (other.isClosed_p) -{ - if (other.pPixelMask_p != 0) { - pPixelMask_p = other.pPixelMask_p->clone(); - } -} - -MIRIADImage& MIRIADImage::operator=(const MIRIADImage& other) -// -// Assignment. Uses reference semantics -// -{ - if (this != &other) { - ImageInterface<Float>::operator= (other); -// - pTiledFile_p = other.pTiledFile_p; // Counted pointer -// - delete pPixelMask_p; - pPixelMask_p = 0; - if (other.pPixelMask_p != 0) { - pPixelMask_p = other.pPixelMask_p->clone(); - } -// - shape_p = other.shape_p; - name_p = other.name_p; - maskSpec_p = other.maskSpec_p; - unit_p = other.unit_p; - rec_p = other.rec_p; - hasBlanks_p = other.hasBlanks_p; - dataType_p = other.dataType_p; - fileOffset_p= other.fileOffset_p; - isClosed_p = other.isClosed_p; - } - return *this; -} - -MIRIADImage::~MIRIADImage() -{ - delete pPixelMask_p; -} - - -LatticeBase* MIRIADImage::openMIRIADImage (const String& name, - const MaskSpecifier& spec) -{ - return new MIRIADImage (name, spec); -} - -void MIRIADImage::registerOpenFunction() -{ - ImageOpener::registerOpenImageFunction (ImageOpener::MIRIAD, - &openMIRIADImage); -} - - -ImageInterface<Float>* MIRIADImage::cloneII() const -{ - return new MIRIADImage (*this); -} - - -String MIRIADImage::imageType() const -{ - return "MIRIADImage"; -} - -Bool MIRIADImage::isMasked() const -{ - return hasBlanks_p; -} - -const LatticeRegion* MIRIADImage::getRegionPtr() const -{ - return 0; -} - -IPosition MIRIADImage::shape() const -{ - return shape_p.shape(); -} - -uInt MIRIADImage::advisedMaxPixels() const -{ - return shape_p.tileShape().product(); -} - -IPosition MIRIADImage::doNiceCursorShape (uInt) const -{ - return shape_p.tileShape(); -} - -void MIRIADImage::resize(const TiledShape&) -{ - throw (AipsError ("MIRIADImage::resize - a MIRIADImage is not writable")); -} - -Bool MIRIADImage::doGetSlice(Array<Float>& buffer, - const Slicer& section) -{ - reopenIfNeeded(); - pTiledFile_p->get (buffer, section); - return False; // Not a reference -} - - -void MIRIADImage::doPutSlice (const Array<Float>&, const IPosition&, - const IPosition&) -{ - throw (AipsError ("MIRIADImage::putSlice - " - "is not possible yet as MIRIADImage is not writable")); -} -#if 0 -Bool MIRIADImage::setUnits (const Unit& unit) -{ - unit_p = unit; - return True; -} - -Unit MIRIADImage::units() const -{ - return unit_p; -} -#endif - -String MIRIADImage::name (Bool stripPath) const -{ - Path path(name_p); - if (stripPath) { - return path.baseName(); - } else { - return path.absoluteName(); - } -} - - -const RecordInterface& MIRIADImage::miscInfo() const -{ - return rec_p; -} - - -Bool MIRIADImage::setMiscInfo(const RecordInterface& rec) -{ - rec_p = rec; - return True; -} - -Bool MIRIADImage::isPersistent() const -{ - return True; -} - -Bool MIRIADImage::isPaged() const -{ - return True; -} - -Bool MIRIADImage::isWritable() const -{ -// Its too hard to implement putMaskSlice becuase -// magic blanking is used. It means we lose -// the data values if the mask is put somewhere - - return False; -} - - -Bool MIRIADImage::ok() const -{ - return True; -} - -Bool MIRIADImage::doGetMaskSlice (Array<Bool>& buffer, const Slicer& section) -{ - if (!hasBlanks_p) { - buffer.resize (section.length()); - buffer = True; - return False; - } -// - reopenIfNeeded(); - return pPixelMask_p->getSlice (buffer, section); -} - - -Bool MIRIADImage::hasPixelMask() const -{ - return hasBlanks_p; -} - -const Lattice<Bool>& MIRIADImage::pixelMask() const -{ - if (!hasBlanks_p) { - throw (AipsError ("MIRIADImage::pixelMask - no pixelmask used")); - } - return *pPixelMask_p; -} - -Lattice<Bool>& MIRIADImage::pixelMask() -{ - if (!hasBlanks_p) { - throw (AipsError ("MIRIADImage::pixelMask - no pixelmask used")); - } - return *pPixelMask_p; -} - -void MIRIADImage::tempClose() -{ - if (! isClosed_p) { - delete pPixelMask_p; - pTiledFile_p = 0; - isClosed_p = True; - } -} - -void MIRIADImage::reopen() -{ - if (isClosed_p) { - open(); - } -} - -uInt MIRIADImage::maximumCacheSize() const -{ - reopenIfNeeded(); - return pTiledFile_p->maximumCacheSize() / ValType::getTypeSize(dataType_p); -} - -void MIRIADImage::setMaximumCacheSize (uInt howManyPixels) -{ - reopenIfNeeded(); - const uInt sizeInBytes = howManyPixels * ValType::getTypeSize(dataType_p); - pTiledFile_p->setMaximumCacheSize (sizeInBytes); -} - -void MIRIADImage::setCacheSizeFromPath (const IPosition& sliceShape, - const IPosition& windowStart, - const IPosition& windowLength, - const IPosition& axisPath) -{ - reopenIfNeeded(); - pTiledFile_p->setCacheSize (sliceShape, windowStart, - windowLength, axisPath); -} - -void MIRIADImage::setCacheSizeInTiles (uInt howManyTiles) -{ - reopenIfNeeded(); - pTiledFile_p->setCacheSize (howManyTiles); -} - - -void MIRIADImage::clearCache() -{ - if (! isClosed_p) { - pTiledFile_p->clearCache(); - } -} - -void MIRIADImage::showCacheStatistics (ostream& os) const -{ - reopenIfNeeded(); - os << "MIRIADImage statistics : "; - pTiledFile_p->showCacheStatistics (os); -} - - - -void MIRIADImage::setup() -{ - if (name_p.empty()) { - throw AipsError("MIRIADImage: given file name is empty"); - } - if (! maskSpec_p.name().empty()) { - throw AipsError("MIRIADImage " + name_p + " has no named masks"); - } - Path path(name_p); - String fullName = path.absoluteName(); - - // cerr << "MIRIAD::setup name=" << fullName << endl; - -// Fish things out of the MIRIAD file - - CoordinateSystem cSys; - IPosition shape; - ImageInfo imageInfo; - Unit brightnessUnit; - - getImageAttributes(cSys, shape, imageInfo, brightnessUnit, rec_p, - hasBlanks_p, fullName); - - // set ImageInterface data - - setCoordsMember (cSys); - setImageInfoMember (imageInfo); - - setUnitMember(brightnessUnit); - - // We need to put the history in some memory based LogSink - // setLogMember(logSink); - - // Set MIRIADImage data - - unit_p = brightnessUnit; - - // MIRIAD 'image' items have an offset of 4 bytes if address directly via tiles - - fileOffset_p = 4; - dataType_p = TpFloat; // Miriad uses only 32bit IEEE floating point - - // See if there is a mask - - hasBlanks_p = False; // for now.... - - // Form the tile shape - shape_p = TiledShape (shape, TiledFileAccess::makeTileShape(shape)); - - // Open the image. - open(); -} - - -void MIRIADImage::open() -{ - Bool writable = False; - Bool canonical = True; - String iname = name_p + "/image"; // fails for very small miriad images !! - - // The tile shape must not be a subchunk in all dimensions - - pTiledFile_p = new TiledFileAccess(iname, fileOffset_p, - shape_p.shape(), shape_p.tileShape(), - dataType_p, TSMOption(), - writable, canonical); - - // Shares the pTiledFile_p pointer. - - if (hasBlanks_p) { - // pPixelMask_p = new Lattice<Bool>; - // pPixelMask_p.resize(shape_p.shape()); - } - - - // Okay, it is open now. - - isClosed_p = False; -} - - -void MIRIADImage::getImageAttributes (CoordinateSystem& cSys, - IPosition& shape, ImageInfo& imageInfo, - Unit& brightnessUnit, Record&, - Bool& hasBlanks, const String& name) -{ - LogIO os(LogOrigin("MIRIADImage", "getImageAttributes", WHERE)); - int naxis = MAXNAX, axes[MAXNAX]; // see miriad's maxdimc.h - int i, ndim; - // Projection projn; - // Vector<Double> projp; - // Projection::Type ptype; - Double offset = 1.0; // miriad crpix 'origin' is 1-based - Int rotationAxis = -1; - - - xyopen_c(&tno_p, const_cast<char *>(name.chars()), "old", naxis, axes); // open miriad file - rdhdi_c(tno_p,"naxis",&ndim,0); // for convenience, get ndim - -#if 0 - // DEBUG: output what size cube we found - cerr << "MIRIAD::getImageAttributes: ["; - for (i=0; i<ndim; i++) { - if (i > 0) cerr << "x"; - cerr << axes[i] ; - } - cerr << "]" << endl; -#endif - - // crackHeader(cSys, shape, imageInfo, brightnessUnit, miscInfo, os); - hasBlanks = FALSE; - - shape.resize(ndim); - for (Int i=0; i<ndim; i++) shape(i) = axes[i]; - - // get a coordinate system. MIRIAD is pretty simple, it only knows - // 'rectangular' coordinate systems, with the usual astronomical conventions - // most of this code has been grabbed from CoordinateSystem::fromFITSHeader - - Vector<Double> cdelt, crval, crpix; - Vector<Int> naxes; - Vector<String> ctype; - Matrix<Double> pc(2,2); - String tmps, digit; - char tmps64[64]; - - cdelt.resize(ndim); - crval.resize(ndim); - ctype.resize(ndim); - crpix.resize(ndim); - - // Units : miriad uses 'bunit' FITS like units without case cares. - - rdhda_c(tno_p, "bunit", tmps64,"",64); - String cunit = tmps64; - UnitMap::addFITS(); - if (UnitVal::check(cunit)) { - brightnessUnit = UnitMap::fromFITS(Unit(cunit)); - } else { - Unit t; - brightnessUnit = t; - os << "FITS unit " << cunit << " unknown to CASA - ignoring." << LogIO::POST; - } - - // get the miriad axes descriptors - for (i=0; i<ndim; i++) { - tmps = "ctype" + digit.toString(i+1); - rdhda_c(tno_p,const_cast<char*>(tmps.chars()), tmps64, "", 64); - ctype(i) = tmps64; - // cerr << tmps << "=>" << ctype(i) << endl; - - tmps = "crval" + digit.toString(i+1); - rdhdd_c(tno_p,const_cast<char *>(tmps.chars()), &crval(i), 0.0); - // cerr << tmps << "=>" << crval(i) << endl; - - tmps = "cdelt" + digit.toString(i+1); - rdhdd_c(tno_p,const_cast<char *>(tmps.chars()), &cdelt(i), 0.0); - // cerr << tmps << "=>" << cdelt(i) << endl; - - tmps = "crpix" + digit.toString(i+1); - rdhdd_c(tno_p,const_cast<char*>(tmps.chars()), &crpix(i), 0.0); - crpix(i) -= offset; - // cerr << tmps << "=>" << crpix(i) << endl; - } - - Int longAxis=-1, latAxis=-1, stokesAxis=-1, spectralAxis=-1; - - for (i=0; i<ndim; i++) { - String subRA(ctype(i).at(0,2)); - String subDEC(ctype(i).at(0,3)); - if (subRA==String("RA") || ctype(i).contains("LON") || subRA==String("LL")) { - if (longAxis >= 0) { - os << LogIO::SEVERE << "More than one longitude axis is " - "present in header!"; - // return False; - } - longAxis = i; - } else if (subDEC==String("DEC") || ctype(i).contains("LAT") || subDEC.contains("MM")) { - if (latAxis >= 0) { - os << LogIO::SEVERE << "More than one latitude axis is " - "present in header!"; - // return False; // we already have a latitude axis! - } - latAxis = i; - } else if (ctype(i).contains("STOKES")) { - stokesAxis = i; - } else if (ctype(i).contains("FREQ") || - ctype(i).contains("FELO") || - ctype(i).contains("VELO")) { - spectralAxis = i; - } - } - - // We must have longitude AND latitude - // (really, what about certain PV diagrams ???) - - if (longAxis >= 0 && latAxis < 0) { - os << LogIO::SEVERE << "We have a longitude axis but no latitude axis!"; - // return False; - } - if (latAxis >= 0 && longAxis < 0) { - os << LogIO::SEVERE << "We have a latitude axis but no longitude axis!"; - // return False; - } - - // DIRECTION - - String proj1, proj2; - Bool isGalactic = False; - if (longAxis >= 0) { - proj1 = ctype(longAxis); - proj2 = ctype(latAxis); - - if (proj1.contains("GLON")) isGalactic = True; - - // Get rid of the first 4 characters, e.g., RA-- - - const Int l1 = proj1.length(); - const Int l2 = proj2.length(); - proj1 = String(proj1.at(4, l1-4)); - proj2 = String(proj2.at(4, l2-4)); - - // Get rid of leading -'s - - proj1.gsub(Regex("^-*"), String("")); - proj2.gsub(Regex("^-*"), String("")); - - // Get rid of spaces - - proj1.gsub(Regex(" *"), String("")); - proj2.gsub(String(" "), String("")); - - if (proj1=="" && proj2=="") { - - // We must abandon making a celestial coordinate if there is no - // projection. Defaulting to cartesian is the wrong thing to do - // We must make a Linear Coordinate from it. - - os << WHERE << LogIO::WARN << - "No projection has been defined so cannot make a Celestial Coordinate\n" - "from this miriad header. Will make a LinearCoordinate instead" << LogIO::POST; - longAxis = -1; - latAxis = -1; - } - } - - if (longAxis >= 0) { - if (proj1 != proj2) { - - // Maybe instead I should switch to CAR, or use the first? - - os << LogIO::SEVERE << "Longitude and latitude axes have different" - " projections (" << proj1 << "!=" << proj2 << ")" << LogIO::POST; - // return False; - } - - // OK, let's make our Direction coordinate and add it to the - // coordinate system. We'll worry about transposing later. MIRIAD - // uses radians by convention - - // First, work out what the projection actually is. - // Special case NCP - now SIN with parameters - - Vector<Double> projp; - Projection::Type ptype; - - ptype = Projection::SIN; - - if (proj1 == "NCP") { - os << LogIO::NORMAL << "NCP projection is now SIN projection in" - " WCS.\nmiriad readers will not handle this correctly." << - LogIO::POST; - ptype = Projection::SIN; - projp.resize(2); - - // According to Greisen and Calabretta - - projp(0) = 0.0; - projp(1) = 1.0/tan(crval(latAxis)); - } else { - ptype = Projection::type(proj1); - if (ptype == Projection::N_PROJ) { - os << LogIO::SEVERE << "Unknown projection: (" << proj1 << ")"; - //return False; - } - // projp header keyword not used in miriad - } - - // OK, now try making the projection - - Projection projn; - - try { - projn = Projection(ptype, projp); - } catch (std::exception& x) { - os << LogIO::SEVERE << "Error forming projection, maybe the " - "wrong number of parameters\n(" << x.what() << ")" << - LogIO::POST; - //return False; - } - - // fish out LONG/LATPOLE (use defaults, since miriad does not - // use those in wcs headers - - Double longPole = 999.0; - Double latPole = 999.0; - - // DEFAULT - - MDirection::Types radecsys = MDirection::J2000; - if (isGalactic) { - radecsys = MDirection::GALACTIC; - } else { - Double epoch; - rdhdd_c(tno_p,"epoch", &epoch, 2000.0); - if (::casacore::near(epoch, 1950.0)) { - radecsys = MDirection::B1950; - } else if (::casacore::near(epoch, 2000.0)) { - radecsys = MDirection::J2000; - } - } - - // make sure this isn't a lie for miriad... - pc(0,0) = pc(1,1) = 1.0; - pc(0,1) = pc(1,0) = 0.0; - - Matrix<Double> dirpc(2,2); - //cerr << "long/lat = " << longAxis << " " << latAxis << endl; - dirpc(0,0) = pc(longAxis, longAxis); - dirpc(0,1) = pc(longAxis, latAxis); - dirpc(1,0) = pc(latAxis, longAxis); - dirpc(1,1) = pc(latAxis, latAxis); - - // watch for cdelt=0 - its okay if that axis is degenerate - // and (crpix+offset)=1 and rotationAxis < 0 = i.e. the only - // pixel on that axis is the reference pixel and there is - // no rotation specified - then cdelt=1 on that axis. If that - // isn't done, that coord. can't be constructed because the - // PC matrix will be reported as singular since its first - // multiplied by cdelt before its used and in this case, that - // doesn't matter since other pixels on that axis are never used. - - if (::casacore::near(cdelt(latAxis), 0.0) && - ::casacore::near(crpix(latAxis)+offset, 1.0) && rotationAxis < 0) { - cdelt(latAxis) = 1.0; // degrees - } - // - if (::casacore::near(cdelt(longAxis), 0.0) && - ::casacore::near(crpix(longAxis)+offset, 1.0) && rotationAxis < 0) { - cdelt(longAxis) = 1.0; // degrees - } - - DirectionCoordinate dir(radecsys, - projn, - crval(longAxis), crval(latAxis), - cdelt(longAxis), cdelt(latAxis), - dirpc, - crpix(longAxis), crpix(latAxis), - longPole, latPole); - cSys.addCoordinate(dir); - } - - // potential bug to track down: - // - a miriad cube that has been processes with 'velsw axis=freq' has slightly - // wrong labels when printed with dImageSummary - - if (spectralAxis >= 0) { - // cerr << "Hey, process spectralAxis = " << spectralAxis << endl; - // see SpectralCoordinate::fromFITS(tmp, error, header, spectralAxis,os); - // and FITSSpectralUtil::fromFITSHeader - // so, as opposed to doing it here, it should be done parallel to those places - // - - Int velref = 2; // Default is optical + topocentric ("OBS") - if (ctype(spectralAxis).contains("VELO")) { - velref = 258; // radio + OBS - } - - // Try to work out OPTICAL/RADIO/. Default to Optical - String type(ctype(spectralAxis).before(4)); - MDoppler::Types velocityPreference = MDoppler::OPTICAL; - if (velref > 256) { - velocityPreference = MDoppler::RADIO; - } - - Double restFrequency; - rdhdd_c(tno_p,"restfreq", &restFrequency, -1.0); - restFrequency *= 1e9; // miriad uses GHz - - // convert the velocity frame tag in ctype to a reference frame - String spectralAxisQualifier; - if (ctype(spectralAxis).length() <= 5) { - spectralAxisQualifier = ""; - } else { - spectralAxisQualifier = ctype(spectralAxis).after(4); - } - - Double referenceChannel = crpix(spectralAxis); - Double referenceFrequency = 0.0; - Double deltaFrequency = 0.0; - Vector<Double> frequencies; - - MFrequency::Types refFrame; - Bool ok = FITSSpectralUtil::frameFromTag(refFrame, - spectralAxisQualifier, - velref); - - if (!ok) { - if (spectralAxisQualifier == "") { - if ((velref%256) >= 0) { - // no tag and velref is unrecognized - os << LogIO::SEVERE << "Illegal value for VELREF(" - << velref << - ") assuming topocentric" << LogIO::POST; - } - } else { - // unrecognized tag - os << LogIO::SEVERE << "Unknown spectral reference frame " - << spectralAxisQualifier << - ". Assuming topocentric." << LogIO::POST; - } - } - - Int nChan = shape(spectralAxis); - Double delt = cdelt(spectralAxis); - Double rval = crval(spectralAxis); - Double rpix = crpix(spectralAxis); - - if (ctype(spectralAxis).contains("FREQ")) { - delt *= 1e9; - rval *= 1e9; - referenceFrequency = rval; - deltaFrequency = delt; - frequencies.resize(nChan); - for (Int i=0; i<nChan; i++) { - frequencies(i) = referenceFrequency + (Double(i)-referenceChannel)*delt; - } - if (restFrequency<0) restFrequency = 0.0; - } else if (ctype(spectralAxis).contains("FELO")) { - delt *= 1e3; - rval *= 1e3; - if (restFrequency < 0) { - os << LogIO::SEVERE << "FELO axis does not have rest frequency " - "information (RESTFREQ)" << LogIO::POST; - // return False; - } else { - // Have RESTFREQ, deduce freq's from velocities and rest freq - referenceChannel = rpix; - switch(velocityPreference) { - case MDoppler::OPTICAL: - { - referenceFrequency = restFrequency / (1.0 + rval/C::c); - deltaFrequency = -delt*referenceFrequency / ( - ( (C::c + rval) ) ); - } - break; - case MDoppler::RADIO: - { - os << LogIO::SEVERE << "FELO/RADIO is illegal" << - LogIO::POST; - // return False; - } - break; - default: - { - AlwaysAssert(0, AipsError); // NOTREACHED - } - } - frequencies.resize(nChan); - for (Int i=0; i<nChan; i++) { - frequencies(i) = referenceFrequency + - (Double(i)-referenceChannel) * deltaFrequency; - } - } - } else if (ctype(spectralAxis).contains("VELO")) { - delt *= 1e3; - rval *= 1e3; - if (restFrequency < 0) { - os << LogIO::SEVERE << "VELO axis does not have rest frequency " - "information (RESTFREQ)" << LogIO::POST; - // return False; - } else { - // Have RESTFREQ - os << LogIO::NORMAL << "ALTRVAL and ALTRPIX have not been " - "supplied in the FITS header, so I \nwill deduce the " - "frequencies from the velocities and rest frequency." << - LogIO::POST; - referenceChannel = rpix; - switch(velocityPreference) { - case MDoppler::RADIO: - { - referenceFrequency = -rval/C::c*restFrequency + - restFrequency; - deltaFrequency = - -delt*referenceFrequency / (C::c - rval); - } - break; - case MDoppler::OPTICAL: - { - os << LogIO::SEVERE << - "VELO/OPTICAL is not implemented" <<LogIO::POST; - // return False; - } - break; - default: - { - AlwaysAssert(0, AipsError); // NOTREACHED - } - } - frequencies.resize(nChan); - for (Int i=0; i<nChan; i++) { - frequencies(i) = referenceFrequency + - (Double(i)-referenceChannel) * deltaFrequency; - } - } - } else { // catch VELO/FELO/FREQ/.... - AlwaysAssert(0, AipsError); // NOTREACHED - } - // SpectralCoordinate::fromFITS - SpectralCoordinate tmp(refFrame, referenceFrequency, deltaFrequency, - referenceChannel, restFrequency); - cSys.addCoordinate(tmp); - } - - - // STOKES. shape is used only here as the StokesCoordinate - // is a bit peculiar, and not really separable from the shape - - if (stokesAxis >= 0) { - if (shape(stokesAxis)>4) { - os << "Stokes axis longer than 4 pixels. This is not acceptable" - << LogIO::EXCEPTION; - //return False; - } - Vector<Int> stokes(shape(stokesAxis)); - - for (Int k=0; k<shape(stokesAxis); k++) { - - // crpix is 0-relative - - Double tmp = crval(stokesAxis) + - (k - crpix(stokesAxis))*cdelt(stokesAxis); - - // cerr << "Stokes: tmp = " << tmp << endl; - if (tmp >= 0) { - stokes(k) = Int(tmp + 0.01); - } else { - stokes(k) = Int(tmp - 0.01); - } - - switch (stokes(k)) { - case -8: - stokes(k) = Stokes::YX; - break; - case -7: - stokes(k) = Stokes::XY; - break; - case -6: - stokes(k) = Stokes::YY; - break; - case -5: - stokes(k) = Stokes::XX; - break; - case -4: - stokes(k) = Stokes::LR; - break; - case -3: - stokes(k) = Stokes::RL; - break; - case -2: - stokes(k) = Stokes::LL; - break; - case -1: - stokes(k) = Stokes::RR; - break; - case 0: - { - os << LogIO::WARN - << "Detected Stokes coordinate = 0; this is an unoffical" << endl; - os << "Convention for an image containing a beam. Putting Stokes=Undefined" << endl; - os << "Better would be to write your FITS image with the correct Stokes" << LogIO::POST; - stokes(k) = Stokes::Undefined; - break; - } - case 1: - { - stokes(k) = Stokes::I; - break; - } - case 2: - stokes(k) = Stokes::Q; - break; - case 3: - stokes(k) = Stokes::U; - break; - case 4: - stokes(k) = Stokes::V; - break; - case 5: - - // Percentage linear polarization not properly supported - - { - os << LogIO::SEVERE << "The Stokes axis has the unofficial percentage polarization value." << endl; - os << "This is not supported. Will use fractional polarization instead " << endl; - os << "You must scale the image by 0.01" << LogIO::POST; - stokes(k) = Stokes::PFlinear; - break; - } - case 6: - stokes(k) = Stokes::PFlinear; - break; - case 7: - stokes(k) = Stokes::Pangle; - break; - case 8: - - // Spectral index not supported - - { - os << LogIO::SEVERE << "The FITS image Stokes axis has the unofficial spectral index value." << endl; - os << "This is not supported. Putting Stokes=Undefined" << LogIO::POST; - stokes(k) = Stokes::Undefined; - break; - } - case 9: - // Optical depth not supported - - { - os << LogIO::SEVERE << "The Stokes axis has the unofficial optical depth" << endl; - os << "value. This is not supported. Putting Stokes=Undefined" << LogIO::POST; - stokes(k) = Stokes::Undefined; - break; - } - default: - { - os << LogIO::SEVERE << "A Stokes coordinate of " << stokes(k) - << " was detected; this is not valid. Putting Stokes=Undefined" << endl; - stokes(k) = Stokes::Undefined; - } - } - } - try { - StokesCoordinate sc(stokes); - cSys.addCoordinate(sc); - } catch (std::exception& x) { - os << LogIO::SEVERE << "Error forming stokes axis : " << x.what() << LogIO::POST; - //return False; - } - } - -// Now we need to work out the transpose order - - Vector<Int> order(ndim); - Int nspecial = 0; - if (longAxis >= 0) nspecial++; - if (latAxis >= 0) nspecial++; - if (stokesAxis >= 0) nspecial++; - if (spectralAxis >= 0) nspecial++; -#if 0 - - // I can't figure this out now, there is something wrong here for miriad - Int linused = 0; - for (i=0; i<ndim; i++) { - if (i == longAxis) { - order(i) = 0; // long is always first if it exist - } else if (i == latAxis) { - order(i) = 1; // lat is always second if it exists - } else if (i == stokesAxis) { - if (longAxis >= 0) { // stokes is axis 0 if no dir, otherwise 2 - order(i) = 3; // 3 for MIRIAD !!! 2 for fits? - } else { - order(i) = 0; - } - } else if (i == spectralAxis) { - if (longAxis >= 0 && stokesAxis >= 0) { - order(i) = 2; // stokes and dir : (3 for fits, 2 for miriad?) - } else if (longAxis >= 0) { - order(i) = 2; // dir only - } else if (stokesAxis >= 0) { - order(i) = 1; // stokes but no dir - } else { - order(i) = 0; // neither stokes or dir - } - } else { - order(i) = nspecial + linused; - linused++; - } - } -// - cSys.transpose(order, order); - -#endif - - // ImageInfo. - - String btype; - rdhda_c(tno_p, "btype", tmps64,"",64); - btype = tmps64; - ImageInfo::ImageTypes type = ImageInfo::MiriadImageType (btype); - if (type!=ImageInfo::Undefined) imageInfo.setImageType(type); -// - Double bmaj, bmin, bpa; - rdhdd_c(tno_p, "bmaj", &bmaj, 0.0); - rdhdd_c(tno_p, "bmin", &bmin, 0.0); - rdhdd_c(tno_p, "bpa", &bpa, 0.0); - if (bmaj>0.0 && bmin>0.0 && abs(bpa)>0.0) { - Quantity qbmaj(bmaj,Unit("rad")); - Quantity qbmin(bmin,Unit("rad")); - Quantity qbpa(bpa,Unit("deg")); - imageInfo.setRestoringBeam(GaussianBeam(qbmaj, qbmin, qbpa)); - } - -// ObsInfo - - ObsInfo oi; - -// DATE-OBS - Double obstime; - rdhdd_c(tno_p, "obstime", &obstime, -1.0); - // cerr << "obstime=" << obstime << endl; - if (obstime > -1.0) { - obstime -= 2400000.5; // make it MJD ("d") - MVEpoch mve(Quantity(obstime,"d")); - MEpoch mep(mve,MEpoch::UTC); // miriad uses JDN (in UTC) -- no good - oi.setObsDate(mep); - } - -// TELESCOP - - String telescop; - rdhda_c(tno_p, "telescop", tmps64,"",64); - telescop = tmps64; - if (!telescop.empty()) { - oi.setTelescope(telescop); - } - -// - cSys.setObsInfo(oi); - xyclose_c(tno_p); -} - - - -} //# NAMESPACE CASACORE - END - Index: casacore-3.5.0/images/Images/MIRIADImage.h =================================================================== --- casacore-3.5.0.orig/images/Images/MIRIADImage.h +++ /dev/null @@ -1,303 +0,0 @@ -//# MIRIADImage.h: Class providing native access to MIRIAD images -//# Copyright (C) 2001 -//# Associated Universities, Inc. Washington DC, USA. -//# -//# This library is free software; you can redistribute it and/or modify it -//# under the terms of the GNU Library General Public License as published by -//# the Free Software Foundation; either version 2 of the License, or (at your -//# option) any later version. -//# -//# This library 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 Library General Public -//# License for more details. -//# -//# You should have received a copy of the GNU Library General Public License -//# along with this library; if not, write to the Free Software Foundation, -//# Inc., 675 Massachusetts Ave, Cambridge, MA 02139, USA. -//# -//# Correspondence concerning AIPS++ should be addressed as follows: -//# Internet email: aips2-request@nrao.edu. -//# Postal address: AIPS++ Project Office -//# National Radio Astronomy Observatory -//# 520 Edgemont Road -//# Charlottesville, VA 22903-2475 USA -//# -//# $Id$ - -#ifndef IMAGES_MIRIADIMAGE_H -#define IMAGES_MIRIADIMAGE_H - - -//# Includes -#include <casacore/casa/aips.h> -#include <casacore/images/Images/ImageInterface.h> -#include <casacore/images/Images/MaskSpecifier.h> -#include <casacore/tables/DataMan/TiledFileAccess.h> -#include <casacore/lattices/Lattices/TiledShape.h> -#include <casacore/casa/Arrays/ArrayFwd.h> -#include <casacore/casa/Containers/Record.h> -#include <casacore/casa/BasicSL/String.h> -#include <casacore/casa/Utilities/DataType.h> - - -namespace casacore { //# NAMESPACE CASACORE - BEGIN - -//# Forward Declarations -template <class T> class Lattice; -// -class MaskSpecifier; -class IPosition; -class Slicer; -class CoordinateSystem; -class FITSMask; -class FitsInput; - - -// <summary> -// Class providing native access to MIRIAD images. -// </summary> - -// <use visibility=export> - -// <reviewed reviewer="" date="" tests="tMIRIADImage.cc"> -// </reviewed> - -// <prerequisite> -// <li> <linkto class=ImageInterface>ImageInterface</linkto> -// <li> <linkto class=FITSMask>FITSMask</linkto> -// </prerequisite> - -// <etymology> -// This class provides native access to MIRIAD images. -// </etymology> - -// <synopsis> -// A MIRIADImage provides native access to MIRIAD images by accessing them -// with the TiledFileAccess class. -- or -- the native miriad I/O routines. -// The MIRIADImage is read only. -- really -- ?? -// -// </synopsis> - -// <example> -// <srcblock> -// MIRIADImage im("cube1"); -// LogIO logger(or); -// ImageStatistics<Float> stats(im, logger); -// Bool ok = stats.display(); // Display statistics -// </srcblock> -// </example> - -// <motivation> -// This provides native access to MIRIAD images. -// </motivation> - -//# <todo asof="2001/09/10"> -//# </todo> - - -class MIRIADImage: public ImageInterface<Float> -{ -public: - // Construct a MIRIADImage from the disk MIRIAD dataset name and apply mask. - explicit MIRIADImage(const String& name); - - // Construct a MIRIADImage from the disk MIRIAD file name and apply mask or not. - MIRIADImage(const String& name, const MaskSpecifier&); - - // Copy constructor (reference semantics) - MIRIADImage(const MIRIADImage& other); - - // Destructor does nothing - ~MIRIADImage(); - - // Assignment (reference semantics) - MIRIADImage& operator=(const MIRIADImage& other); - - // Function to open a MIRIAD image. - static LatticeBase* openMIRIADImage (const String& name, - const MaskSpecifier&); - - // Register the open function. - static void registerOpenFunction(); - - //# ImageInterface virtual functions - - // Make a copy of the object with new (reference semantics). - virtual ImageInterface<Float>* cloneII() const; - - // Get the image type (returns MIRIADImage). - virtual String imageType() const; - - // Function which changes the shape of the MIRIADImage. - // Throws an exception as MIRIADImage is not writable. - virtual void resize(const TiledShape& newShape); - - // Functions which get and set the units associated with the image - // pixels (i.e. the "brightness" unit). Initially the unit is empty. - // Although the MIRIADimage is not writable, you can change the - // unit in the MIRIADImage object, but it will not be changed - // in the MIRIAD disk file. - // <group> -#if 0 - virtual Bool setUnits(const Unit& newUnits); - virtual Unit units() const; -#endif - // </group> - - // Often we have miscellaneous information we want to attach to an image. - // Although MIRIADImage is not writable, you can set a new - // MiscInfo record, but it will not be stored with the MIRIAD file - // <group> - virtual const RecordInterface &miscInfo() const; - virtual Bool setMiscInfo(const RecordInterface &newInfo); - // </group> - - //# MaskedLattice virtual functions - - // Has the object really a mask? The MIRIADImage always - // has a pixel mask and never has a region mask so this - // should always return True - virtual Bool isMasked() const; - - // MIRIADimage always has a pixel mask so should return True - virtual Bool hasPixelMask() const; - - // Get access to the pixelmask. MIRIADImage always has a pixel mask. - // <group> - virtual const Lattice<Bool>& pixelMask() const; - virtual Lattice<Bool>& pixelMask(); - // </group> - - // Do the actual get of the mask data. The return value is always - // False, thus the buffer does not reference another array. - virtual Bool doGetMaskSlice (Array<Bool>& buffer, const Slicer& section); - - // Get the region used. There is no region. - // Always returns 0. - virtual const LatticeRegion* getRegionPtr() const; - - - //# Lattice virtual functions - - // Do the actual get of the data. - // Returns False as the data do not reference another Array - virtual Bool doGetSlice (Array<Float>& buffer, const Slicer& theSlice); - - // The MIRIADImage is not writable, so this throws an exception. - virtual void doPutSlice (const Array<Float>& sourceBuffer, - const IPosition& where, - const IPosition& stride); - - //# LatticeBase virtual functions - - // The lattice is paged to disk. - virtual Bool isPaged() const; - - // The lattice is persistent. - virtual Bool isPersistent() const; - - // The MIRIADImage is not writable. - virtual Bool isWritable() const; - - // Returns the name of the disk file. - virtual String name (Bool stripPath=False) const; - - // return the shape of the MIRIADImage - virtual IPosition shape() const; - - // Returns the maximum recommended number of pixels for a cursor. This is - // the number of pixels in a tile. - virtual uInt advisedMaxPixels() const; - - // Help the user pick a cursor for most efficient access if they only want - // pixel values and don't care about the order or dimension of the - // cursor. - virtual IPosition doNiceCursorShape (uInt maxPixels) const; - - // Temporarily close the image. - virtual void tempClose(); - - // Reopen a temporarily closed image. - virtual void reopen(); - - // Check class invariants. - virtual Bool ok() const; - - // Return the (internal) data type (TpFloat or TpShort). - DataType dataType () const - { return dataType_p; } - - // Maximum size - not necessarily all used. In pixels. - virtual uInt maximumCacheSize() const; - - // Set the maximum (allowed) cache size as indicated. - virtual void setMaximumCacheSize (uInt howManyPixels); - - // Set the cache size as to "fit" the indicated path. - virtual void setCacheSizeFromPath (const IPosition& sliceShape, - const IPosition& windowStart, - const IPosition& windowLength, - const IPosition& axisPath); - - // Set the actual cache size for this Array to be be big enough for the - // indicated number of tiles. This cache is not shared with PagedArrays - // in other rows and is always clipped to be less than the maximum value - // set using the setMaximumCacheSize member function. - // tiles. Tiles are cached using a first in first out algorithm. - virtual void setCacheSizeInTiles (uInt howManyTiles); - - // Clears and frees up the caches, but the maximum allowed cache size is - // unchanged from when setCacheSize was called - virtual void clearCache(); - - // Report on cache success. - virtual void showCacheStatistics (ostream& os) const; - -private: - String name_p; // filename, as given - Int tno_p; // miriad file handle - MaskSpecifier maskSpec_p; - Unit unit_p; - Record rec_p; - CountedPtr<TiledFileAccess> pTiledFile_p; - Lattice<Bool>* pPixelMask_p; - // Float scale_p; - // Float offset_p; - // Short magic_p; - TiledShape shape_p; - Bool hasBlanks_p; - DataType dataType_p; // always float's for miriad - Int64 fileOffset_p; // always 4 for direct (tiled) access - Bool isClosed_p; - -// Reopen the image if needed. - void reopenIfNeeded() const - { if (isClosed_p) const_cast<MIRIADImage*>(this)->reopen(); } - -// Setup the object (used by constructors). - void setup(); - -// Open the image (used by setup and reopen). - void open(); - -// Fish things out of the MIRIAD file - void getImageAttributes (CoordinateSystem& cSys, - IPosition& shape, ImageInfo& info, - Unit& brightnessUnit, Record& miscInfo, - Bool& hasBlanks, const String& name); - -// <group> - void crackHeader (CoordinateSystem& cSys, - IPosition& shape, ImageInfo& imageInfo, - Unit& brightnessUnit, Record& miscInfo, - LogIO&os); - -// </group> -}; - - - -} //# NAMESPACE CASACORE - END - -#endif Index: casacore-3.5.0/images/Images/test/tMIRIADImage.cc =================================================================== --- casacore-3.5.0.orig/images/Images/test/tMIRIADImage.cc +++ /dev/null @@ -1,201 +0,0 @@ -//# tMIRIADImage.cc: test the MIRIADImage class -//# Copyright (C) 1994,1995,1998,1999,2000,2001 -//# Associated Universities, Inc. Washington DC, USA. -//# -//# This program 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. -//# -//# This program 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 this program; if not, write to the Free Software Foundation, Inc., -//# 675 Massachusetts Ave, Cambridge, MA 02139, USA. -//# -//# Correspondence concerning AIPS++ should be addressed as follows: -//# Internet email: aips2-request@nrao.edu. -//# Postal address: AIPS++ Project Office -//# National Radio Astronomy Observatory -//# 520 Edgemont Road -//# Charlottesville, VA 22903-2475 USA -//# -//# $Id$ - -#include <casacore/casa/aips.h> -#include <casacore/casa/Arrays/Array.h> -#include <casacore/casa/IO/ArrayIO.h> -#include <casacore/casa/Containers/Record.h> -#include <casacore/casa/Inputs/Input.h> -#include <casacore/casa/BasicMath/Math.h> -#include <casacore/casa/OS/Path.h> -#include <casacore/casa/BasicSL/String.h> -#include <casacore/casa/Utilities/DataType.h> -#include <casacore/casa/Exceptions/Error.h> -#include <casacore/casa/Logging/LogIO.h> - -#include <casacore/images/Images/MIRIADImage.h> -#include <casacore/images/Images/ImageInterface.h> -#include <casacore/images/Images/ImageFITSConverter.h> -#include <casacore/coordinates/Coordinates/CoordinateSystem.h> - -#include <casacore/casa/iostream.h> - -#include <casacore/casa/namespace.h> -Bool allNear (const Array<Float>& data, const Array<Bool>& dataMask, - const Array<Float>& mir, const Array<Bool>& mirMask, Float tol=1.0e-5); - -int main (int argc, const char* argv[]) -{ -try { - - LogIO os(LogOrigin("tMIRIADImage", "main()", WHERE)); - -// Get inputs - - Input inputs(1); - inputs.create("in", "", "Input MIRIAD file"); - inputs.create("print", "F", "Print some data"); - inputs.create("size", "5", "Size to print"); -// - inputs.readArguments(argc, argv); - String in = inputs.getString("in"); - const Bool print = inputs.getBool("print"); - const Int size = inputs.getInt("size"); -// - if (in.empty()) { -#if 0 - in = "imagetestimage.mir"; -#else - in = "test2.mir"; -#endif - } - Path p(in); - - cout << p.originalName() << endl; - -// Open MIRIADImage - - MIRIADImage mirImage(in); - mirImage.tempClose(); - AlwaysAssert(mirImage.imageType()=="MIRIADImage", AipsError); - Unit unit("Jy/beam"); - AlwaysAssert(mirImage.setUnits(unit), AipsError); - AlwaysAssert(mirImage.units().getName()=="Jy/beam", AipsError); - Record rec; - rec.define("field1", 0.0); - rec.define("field2", "doggies"); - AlwaysAssert(mirImage.setMiscInfo(rec), AipsError); - mirImage.reopen(); - Record rec2 = mirImage.miscInfo(); - AlwaysAssert(rec.isDefined("field1"), AipsError); - AlwaysAssert(rec.isDefined("field2"), AipsError); - AlwaysAssert(rec.asFloat("field1")==0.0, AipsError); - AlwaysAssert(rec.asString("field2")=="doggies", AipsError); - AlwaysAssert(mirImage.hasPixelMask() == mirImage.isMasked(), AipsError); -#if 0 - if (mirImage.hasPixelMask()) { - Lattice<Bool>& pMask = mirImage.pixelMask(); - AlwaysAssert(pMask.shape()==mirImage.shape(), AipsError); - } -#endif - AlwaysAssert(mirImage.getRegionPtr()==0, AipsError); - AlwaysAssert(mirImage.isWritable()==False, AipsError); - AlwaysAssert(mirImage.name(False)==p.absoluteName(),AipsError); - AlwaysAssert(mirImage.ok(), AipsError); -// - mirImage.tempClose(); - if (print) { - IPosition start (mirImage.ndim(),0); - IPosition shape(mirImage.shape()); - for (uInt i=0; i<mirImage.ndim(); i++) { - if (shape(i) > size) shape(i) = size; - } - cerr << "Data = " << mirImage.getSlice(start, shape) << endl; - cerr << "Mask = " << mirImage.getMaskSlice(start, shape) << endl; - } - -// Convert from MIRIAD as a comparison - - String error; - ImageInterface<Float>* pTempImage = 0; - String imageName; -#if 1 - if (!ImageFITSConverter::FITSToImage(pTempImage, error, - imageName, in+".fits", 0)) { - os << error << LogIO::EXCEPTION; - } - - // need to fill pTempImage .... - - Array<Float> mirArray = mirImage.get(); - Array<Float> dataArray = pTempImage->get(); - Array<Bool> mirMask = mirImage.getMask(); - Array<Bool> dataMask = pTempImage->getMask(); - CoordinateSystem mirCS = mirImage.coordinates(); - CoordinateSystem dataCS = pTempImage->coordinates(); - delete pTempImage; -// - AlwaysAssert(allNear(dataArray, dataMask, mirArray, mirMask), AipsError); - AlwaysAssert(mirCS.near(dataCS), AipsError); - -// Test Clone - - ImageInterface<Float>* pMirImage = mirImage.cloneII(); - Array<Float> mirArray2 = pMirImage->get(); - Array<Bool> mirMask2 = pMirImage->getMask(); - CoordinateSystem mirCS2 = pMirImage->coordinates(); - delete pMirImage; -// - AlwaysAssert(allNear(dataArray, dataMask, mirArray2, mirMask2), AipsError); - AlwaysAssert(mirCS2.near(dataCS), AipsError); -// -#endif - - cerr << "ok " << endl; - - -} catch (std::exception& x) { - cerr << "aipserror: error " << x.what() << endl; - return 1; -} - - - return 0; -} - -Bool allNear (const Array<Float>& data, const Array<Bool>& dataMask, - const Array<Float>& mir, const Array<Bool>& mirMask, - Float tol) -{ - Bool deletePtrData, deletePtrDataMask, deletePtrMIRIAD, deletePtrMIRIADMask; - const Float* pData = data.getStorage(deletePtrData); - const Float* pMIRIAD = mir.getStorage(deletePtrMIRIAD); - const Bool* pDataMask = dataMask.getStorage(deletePtrDataMask); - const Bool* pMIRIADMask = mirMask.getStorage(deletePtrMIRIADMask); -// - for (uInt i=0; i<data.nelements(); i++) { - if (pDataMask[i] != pMIRIADMask[i]) { - cerr << "masks differ" << endl; - return False; - } - if (pDataMask[i]) { - if (!near(pData[i], pMIRIAD[i], tol)) { - cerr << "data differ, tol = " << tol << endl; - cerr << pData[i] << ", " << pMIRIAD[i] << endl; - return False; - } - } - } -// - data.freeStorage(pData, deletePtrData); - dataMask.freeStorage(pDataMask, deletePtrDataMask); - mir.freeStorage(pMIRIAD, deletePtrMIRIAD); - mirMask.freeStorage(pMIRIADMask, deletePtrMIRIADMask); - return True; -} - -
Locations
Projects
Search
Status Monitor
Help
OpenBuildService.org
Documentation
API Documentation
Code of Conduct
Contact
Support
@OBShq
Terms
openSUSE Build Service is sponsored by
The Open Build Service is an
openSUSE project
.
Sign Up
Log In
Places
Places
All Projects
Status Monitor
