diff options
| author | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-03-05 12:53:09 -0500 |
|---|---|---|
| committer | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-03-05 12:53:09 -0500 |
| commit | 832b4b34ff8ce84a13751883c0822c16c152fe48 (patch) | |
| tree | edb4d7050c37ade55bc543de80e76e58c4486908 | |
| parent | 8f848043369b49e861942ce132181fed2c53c2d3 (diff) | |
| download | calfuse-832b4b34ff8ce84a13751883c0822c16c152fe48.tar.gz | |
Massive rework
45 files changed, 17360 insertions, 0 deletions
diff --git a/doc/FIXING_SELINUX_ISSUES b/doc/FIXING_SELINUX_ISSUES new file mode 100644 index 0000000..548077b --- /dev/null +++ b/doc/FIXING_SELINUX_ISSUES @@ -0,0 +1,84 @@ + +------------------------------------------------------------------------------- + Fixing issues due to SELinux +------------------------------------------------------------------------------- + +While installing CalFUSE 3.2.0 on Scientific Linux V 5.0 the following +SELinux issues came up. SELinux points to these web pages for a more +detailed explanation of the issues: +http://people.redhat.com/drepper/selinux-mem.html and +http://people.redhat.com/drepper/textrelocs.html + +A suggestion from the http://people.redhat.com/drepper/textrelocs.html +web page is to compile the c libraries with -fpic or -fPIC. + +The first SELinux issue maybe related to this being a new install of Scientific Linux and +not truly related to CalFUSE. + + +Summary +------- + +SELinux is preventing access to files with the label, file_t. + +Detailed Description + +SELinux permission checks on files labeled file_t are being +denied. file_t is the context the SELinux kernel gives to files that do not have a label. +This indicates a serious labeling problem. No files on an SELinux box should ever be +labeled file_t. If you have just +added a new disk drive to the system you can relabel it using the restorecon command. +Otherwise you should relabel the entire files system. + +Allowing Access + +You can execute the following command as root to relabel your computer +system: + +touch /.autorelabel; reboot + +Note that this will reboot your computer system. + + +Summary +------- + +SELinux is preventing /calfuse/v3.2/bin/cf_hist_init from loading +/calfuse/v3.2/lib/libcf.so, +/calfuse/v3.2/lib/libsla.so, and +/calfuse/v3.2/lib/libcfitsio-2.470.so +which require text relocation. + + +Detailed Description + +The /calfuse/v3.2/bin/cf_hist_init application attempted to load +/calfuse/v3.2/lib/libcf.so, +/calfuse/v3.2/lib/libsla.so, and +/calfuse/v3.2/lib/libcfitsio-2.470.so +which require text relocation. This is a potential security problem. Most libraries do +not need this permission. Libraries are sometimes coded incorrectly and request this +permission. The SELinux Memory Protection Tests web page explains how to remove this +requirement. You can configure SELinux temporarily to allow +/calfuse/v3.2/lib/libcf.so, +/calfuse/v3.2/lib/libsla.so, and +/calfuse/v3.2/lib/libcfitsio-2.470.so +to use relocation as a workaround, until the libraries are fixed. +Please file a bug report against this package. + +Allowing Access + +If you trust +/calfuse/v3.2/lib/libcf.so, +/calfuse/v3.2/lib/libsla.so, and +/calfuse/v3.2/lib/libcfitsio-2.470.so +to run correctly, you can change the file context to textrel_shlib_t. + +The following commands will allow this access: + +chcon -t textrel_shlib_t /calfuse/v3.2/lib/libcf.so +chcon -t textrel_shlib_t /calfuse/v3.2/lib/libsla.so +chcon -t textrel_shlib_t /calfuse/v3.2/lib/libcfitsio-2.470.so + + +- Michael E. Van Steenberg diff --git a/doc/INSTALLING_A_FORTRAN_COMPILER b/doc/INSTALLING_A_FORTRAN_COMPILER new file mode 100644 index 0000000..9af64ff --- /dev/null +++ b/doc/INSTALLING_A_FORTRAN_COMPILER @@ -0,0 +1,259 @@ + +------------------------------------------------------------------------------- + INSTALLING A FORTRAN COMPILER +------------------------------------------------------------------------------- + +Please note that these are solutions that we tried and therefore recommend, +especially since they worked on every machine we tried, but there might be other +solutions if none of this works for you. Just google fortran and your machine +specs and you should find some ideas. + + +FORTRAN for Solaris: +-------------------- + + CalFUSE has been compiled and tested on Solaris with the Fortran + compilers provided by SUN (f77 and f90) and GNU (g77 and gfortran). + Both are available for free, so even if you already have another fortran + compiler, you should get one of these. Other Fortran compilers may + work, but we cannot guarantee your results. + + -> We recommend that you first try the Sun Studio Compilers from Sun's + development website: + http://developers.sun.com/sunstudio/downloads/index.jsp + CalFUSE compiles properly with version 12. + + -> An old version of Fortran may already exist on your machine. Look for + the old 'libF77.so' and 'libM77.so' libraries in one of these + directories: '/usr/4lib' and '/opt/SUNWspro/lib/'. They would probably + have a name with a version number at the end. If so, you can try to + create symbolic links to these two (with the command 'ln -s <library> + <link>') using their exact names 'libF77.so' and 'libM77.so'. Then add + to your LD_LIBRARY_PATH environment variable the directory in which you + created the two links. Also add '/opt/SUNWspro/bin/' to your PATH and + try again to run the CalFUSE configure routine. + + -> Otherwise, you can try to install 'g77' from the GNU compilers by + installing the package 'gcc-3.4.6'. (We were unable to make 'gfortran' + from GCC version 4 and higher work on Solaris.) You will need root + access to do so. + + First type the command 'iconv' in your shell. If it returns "command + not found", then you must first install the package libiconv as well. + + You can retrieve packages for various versions of Solaris (7 to 10) and + different CPU architectures (Sparc or Intel) from this website (select + the appropriate system/CPU combination in the menu on the right side): + http://www.sunfreeware.com + + If the web page download fails, you can access the packages by ftp + ( where <CPU> = sparc or intel and <V> = 7, 8, 9 or 10 ): + ftp ftp.sunfreeware.com + login: anonymous + password: <your_email_address> + binary + cd pub/freeware/<CPU>/<V>/ + get gcc-3.4.6-sol<V>-<CPU>-local.gz + get libiconv-1.11-sol<V>-<CPU>-local.gz (if iconv is missing) + bye + + When you have the necessary packages, first add '/usr/local/bin' to your + PATH environment variable and '/usr/local/man' to your MANPATH. Then + unzip the packages with 'gunzip' and, as root, type the following + commands: + > pkgadd -d libiconv-1.9.2-sol<V>-<CPU>-local (if iconv is missing) + > pkgadd -d gcc-3.4.6-sol<V>-<CPU>-local + + -> You can also try to recompile the GCC compilers yourself from the source + available on the GNU website: + http://ftp.gnu.org/gnu/gcc/ + But this is a very long (it took us 10 hours) and complicated process, + and we recommend that you install the package as described above. + + If you really have to compile the code by hand, for example because + you cannot get root permission, follow these instructions: + - Choose the latest 3.x.x version available. (We were unable to + install fortran version 4.x.x because the necessary libraries were + missing.) + - Create three directories, none of them a subdirectory of another: + srcdir - to contain the source archive + bindir - where the binaries will be installed + insdir - from which you will do the install + For example, I had respectively '/home/ooghe/gcc/src/', + '/home/ooghe/gcc/bin/' and '/home/ooghe/gcc/install/'. + - Unzip and untar the downloaded archive in 'srcdir' + - Echo your 'PATH' environment variable and remove '/usr/ucb/bin' + from it if it is present. Add '/usr/sfw/bin' if it is not. + For example: + > export PATH=/usr/bin:/etc:/usr/sbin:/usr/sfw/bin:/usr/ccs/bin:. + - Do the following: + > export CONFIG_SHELL=/bin/ksh + - Go to 'insdir' and do the following: + > 'srcdir'/configure --prefix='bindir' --enable-languages=c,fortran + where 'srcdir' and 'gccdir' should be complete path directories, e.g., + '/home/username/gcc/src' and '/home/username/gcc/bin' + - Bootstrap and finally install the compiler: + > gmake bootstrap + > gmake install + - Add 'bindir'/bin to your PATH environment variable, and + 'bindir'/lib to your LD_LIBRARY_PATH one. + + +=============================================================================== + +FORTRAN for Linux: +------------------ + + CalFUSE has been compiled and tested on Linux with the Fortran compilers + provided by GNU (g77 and gfortran). They are available for free, so + even if you already have another fortran compiler, you should get one of + these. You can try to make CalFUSE work with another compiler, but we + cannot guarantee your results. + + Most Linux distributions include one of the GNU Fortran compilers, but + if it is not on yours, you should first try to get a binary for your + machine. + + -> If your Linux is based on a distribution like Debian, Fedora or SUSE, + look for a binary on this web page: + http://gcc.gnu.org/wiki/GFortranDistros + + -> Otherwise, you can try to install the latest binary from this web page, + but we do not recommend it because the latest compilers may still contain + some bugs: + http://gcc.gnu.org/wiki/GFortranBinaries + + -> If you do not have any other solution, you should recompile GCC from the + source by following the instructions available on + http://gcc.gnu.org/wiki/GFortranBinaries + + +=============================================================================== + +FORTRAN for MAC OS X: +--------------------- + + + CalFUSE has been compiled and tested on MAC OS X with the Fortran + compilers provided by GNU (g77 and gfortran). They are available for + free, so even if you already have another Fortran compiler (like ifort + from Intel or f77 from ABSoft), you should get one of these. You can + try to make CalFUSE work with another compiler, but we cannot guarantee + your results. + + There are many ways to install the GNU compilers on a MAC; + here are some suggestions: + + -> For Mac OS X 10.4 (Tiger) or higher, we know that the installation + provided on this web page works well: + http://www.macresearch.org/xcode_gfortran_contest_winner_damien_bobillot + Just download the gfortran compiler corresponding to your CPU + architecture (Intel or PowerPC) and follow the "gfortran compiler + instructions". + + If this web page is down, you can get the same archives from the + CalFUSE FTP site: + + ftp fuse.pha.jhu.edu + login: anonymous + password: <your_email_address> + + cd fuseftp/calfuse + binary + (PPC) get macos-gfortran-intel-bin.tar.gz + (Intel) get macos-gfortran-ppc-bin.tar.gz + bye + + When you have the appropriate package, install the compiler + using the following command: + (PPC) sudo tar -zxvf macos-gfortran-ppc-bin.tar.gz -C / + (Intel) sudo tar -zxvf macos-gfortran-intel-bin.tar.gz -C / + + Note: It is possible that /usr/local/bin is not in your default + PATH environment variable. If the command 'gfortran' does not work, + then, assuming you're using the default bash shell, type + (or include in /etc/profile): + > export PATH=/usr/local/bin:$PATH + + -> Otherwise, you can try to find more recent versions of these + packages on these different websites, but we don't recommend them + because they usually still have a few development bugs: + http://hpc.sourceforge.net/ + http://www.macresearch.org/xcode_gfortran_plugin_update + http://gcc.gnu.org/wiki/GFortranBinariesMacOS + + -> You can also try to install yourself a version of gfortran or + g77 from one of GCC releases at this address: + http://ftp.gnu.org/gnu/gcc/ + This might be the only solution if you are using Mac OS X 10.3 + or lower. + In this specific case, we recommend that you try first to install + 'g77' from 'gcc-3.3.3', following Jeff's instructions as follows: + +------------------------------------------------------------------------------- +Jeff Kruk +31 May 2004 + +Hi All- + +I have successfully installed GNU fortran on my Mac laptop. +It is not part of the Apple Developer tools (at least not anymore), +so you have to get it directly from GNU. The instructions from GNU +state that you need the whole source tree to compile the compilers, +so you have to ignore the portions of the GCC package that are provided +by Apple with their developers toolkit. + +After reading through lots of instructions, I concluded that all the +default options were just fine. So, here is a boiled-down set of +instructions. + +You will need 3 different directories: +srcdir: where you put all the files from GNU +objdir: where you do the build +installdir: this defaults to /usr/local, which is what I used. +(You may have to do this as root to put things in /usr/local) + +The one complication is that GNU "strongly recommends" that none of +these directories be subdirectories of one another. +So I put the downloaded files in /Users/kruk/Desktop/gcc-3.3.3 +and I did the build in /Users/kruk/gcc/bin. + +Here's the sequence of commands needed: + +1) Use your browser to go to +http://ftp.gnu.org/gnu/gcc/releases/gcc-3.3.3 +click on gcc-3.3.3.tar.gz +unpack this in 'srcdir' (in my case this was ~/Desktop/gcc-3.3.3) + +2) Make the directory where you will do the build. In my case this was: +> cd ~ +> mkdir gcc +> mkdir bin +> cd gcc/bin + +3) Configure all the files: +> ~/Desktop/gcc-3.3.3/configure + +4) Make the compilers: +> gnumake bootstrap +(I think the default 'make' is the same as gnumake, but I wasn't taking +any chances) +When this completes, there are no files in /usr/local yet! + +5) Do the actual install: +> gnumake install + +[This can take a long time -- up to 90 minutes. - Ed.] + +That's it! + +Note: If you are using an Intel-based Mac, also follow these instructions + from Vincent Hénault-Brunet: "I recently compiled CalFUSE on my Mac + Intel laptop. The problem had to do with g77. I didn't know, but g77 + doesn't work on Mac Intel. It will compile but doesn't work properly. + I had to patch the power-pcc version of g77 (patch found at + http://www1.gly.bris.ac.uk/~wookey/MEFTLG/g77.htm ), and CalFUSE + compiled without any problem." + + +- Van Dixon, Bernard Godard, Jeff Kruk and Benjamin Ooghe-Tabanou diff --git a/doc/INSTALLING_CalFUSEv3.2.3 b/doc/INSTALLING_CalFUSEv3.2.3 new file mode 100644 index 0000000..9579254 --- /dev/null +++ b/doc/INSTALLING_CalFUSEv3.2.3 @@ -0,0 +1,215 @@ +# +# Note: Before downloading CalFUSE, please send a blank e-mail to +# fuse_support@pha.jhu.edu with the subject line "GOT CALFUSE". +# We'll save your address and send you information about future +# software updates or bug reports. Thanks! +# + +------------------------------------------------------------------------------- + INSTALLING CalFUSE v3.2.3 +------------------------------------------------------------------------------- + +These instructions cover Solaris, Linux, Linux 64, and Mac OS X +installations. + +You will need at least 1.6 GB of disk space to install the pipeline and +its associated calibration files. + +The software is in the tar file cfv3.2.3.sw.tar.gz + +The calibration files are divided among three tar files: + +cfv3.2.3.cala.tar.gz <-- Cal files that start with letter a +cfv3.2.3.calg.tar.gz <-- Cal files that start with letter g +cfv3.2.3.calz.tar.gz <-- All other cal files + + +A. DOWNLOADING THE CALFUSE SOFTWARE AND ASSOCIATED CALIBRATION FILES: +--------------------------------------------------------------------- + + Obtain the compressed tar files: + + prompt> ftp fuse.pha.jhu.edu + login: anonymous + password: <your_email_address> + + cd fuseftp/calfuse + binary + get cfv3.2.3.sw.tar.gz + get cfv3.2.3.cala.tar.gz + get cfv3.2.3.calg.tar.gz + get cfv3.2.3.calz.tar.gz + bye + + Uncompress and extract all tarfiles in your calfuse directory. + + +B. INSTALLATION INSTRUCTIONS: +----------------------------- + +0) Note for all systems: + + You need to type "make -e install" only once, not in each + subdirectory. + + +1) SOLARIS + + First check whether '/opt/SUNWspro/lib' is in your + 'LD_LIBRARY_PATH' environment variable. If it is not, be + sure to add it. + + In [calfuse_directory]/v3.2/src, type: + + make distclean + chmod +x configure.solaris + ./configure.solaris + make clean + make -e install + + The Solaris operating system should come with a Fortran + compiler; however, if the configure routine returns an error + message about Fortran, it is probably missing, and you will + have to install it. To do so, follow the instructions for + Solaris in the file INSTALLING_A_FORTRAN_COMPILER. + + +2) LINUX and LINUX 64 + + If you are running Linux on a 64-bit machine, you must also + install a 64-bit version of the CFITSIO library. You + can skip this step if your machine is running in 32-bit + mode. The operation may require root access to your system, + so you may have to ask for help from your system manager. + First use your 'Applications/Add-Remove Software' + tool to see whether CFITSIO is available by default on + your system (as it is for Scientific Linux version 5.0). + If so, install it; if not, you can download the release + corresponding to your operating system from the Internet. + Search for 'cfitsio' on the web page http://rpm.pbone.net/. + If this page is not available, search the FITSIO webpage + (http://heasarc.gsfc.nasa.gov/docs/software/fitsio/fitsio.html) + for RPM format distributions. + + Once the necessary libraries are installed, move to the + directory [calfuse_directory]/v3.2/src and type + + make distclean + chmod +x configure.linux or chmod +x configure.linux64 + ./configure.linux or ./configure.linux64 + make clean + make -e install + + Notes: + + a) GCC should come with a Fortran compiler; however, if the + configure routine returns an error message about Fortran, + it is probably missing, and you will have to install it. + To do so, follow the instructions for Linux in the file + INSTALLING_A_FORTRAN_COMPILER. + + b) If the compilation fails with an error such as: + "undefined reference to '_gfortran_pow_i4_i4'" or similar, + it probably means you have both g77 and gfortran installed. + In this case we recommand that you try to remove the gfortran + package from your Linux distribution (using synaptic, apt-get + or aptitude, for example). + + c) Linux64 users: If you installed cfitsio in a directory + other than the usual '/usr/include/cfitsio', determine the + path you used, for example '/usr/local/cfitsio64' and, in + [calfuse_directory]/v3.2/src, type the following commands, + where <new_path> is the path identified above: + + cp configure.linux64 configure.linux64.sv + sed -e "s#/usr/include/cfitsio#<new_path>#g#" \ + configure.linux64.sv > configure.linux64.sv2 + sed -e "s/#cfit/ /g" \ + configure.linux64.sv2 > configure.linux64 + + Then restart the installation procedure. + + d) If you encounter trouble with SELinux while installing + CalFUSE, you should read the informations from Michael Van + Steenberg in the file FIXING_SELINUX_ISSUES. + + +3) MAC OS X + + In [calfuse_directory]/v3.2/src type + + make distclean + chmod +x configure.macosx + ./configure.macosx + make clean + make -e install + + Notes: + + a) CalFUSE requires Mac OS X 10.2 or higher. + + b) CalFUSE uses both the C and Fortran compilers. If you + are running OS X 10.3 or above, you probably have a C + compiler. If not, retrieve the Xcode suite of developer + tools from the Apple Developer Connection website + (developer.apple.com). To obtain the Fortran compiler, + follow the instructions for MacOS in the file + INSTALLING_A_FORTRAN_COMPILER. + + c) If the linker complains about missing library routines, + you may need to modify the definition of LIBS in the various + Makefiles. For example, you may need to replace "-L/usr/local/lib" + with "-L/sw/lib". + + d) For best results, run CalFUSE in an X11 window; otherwise, + your trailer files will be full of warning messages from IDL. + + e) FYI: the environment variable called 'LD_LIBRARY_PATH' + on other systems is called 'DYLD_LIBRARY_PATH' by Mac OS. + + +C. SETTING THE ENVIRONMENT VARIABLES: +------------------------------------- + + The directory '[calfuse_directory]/v3.2/bin' contains the + scripts 'cfsetup.sh' and 'cfsetup.csh', which define the + environment variables needed by CalFUSE. You will run one + of these two depending on the shell you are using. + + Usually, if you are on a Solaris machine or on a Mac running + OS X 10.2, you will use the '.csh' script. On Linux and + more recent versions of MAC OS X, you should probably use + the '.sh' script. If one gives you an error message, try + the other. + + The scripts assume that you have installed the pipeline in + your home directory. If you have installed it elsewhere, + you must edit the script, changing the root CalFUSE directory + ('CF_DIR') defined at the beginning. + + If you are using the '.csh' script, do the following: + source cfsetup.csh + rehash + If you are using the '.sh' script, do the following: + source cfsetup.sh + hash -r + + You can also insert the whole script into your '.login' + file, in which case the environment variables will be set + each time you log in. + + +D. RUNNING THE PIPELINE: +------------------------ + + To run the pipeline on either timetag or histogram + data, just type 'calfuse' followed by the name of the raw + data file. For example: + + calfuse P99901010011attagfraw.fit + calfuse P99901010011ahistfraw.fit + + +Address questions or concerns to fuse_support@pha.jhu.edu. + +- Van Dixon, Bernard Godard, and Benjamin Ooghe-Tabanou diff --git a/doc/INTRO_TO_CalFUSEv3.2.3 b/doc/INTRO_TO_CalFUSEv3.2.3 new file mode 100644 index 0000000..0408121 --- /dev/null +++ b/doc/INTRO_TO_CalFUSEv3.2.3 @@ -0,0 +1,385 @@ +# Documentation for CalFUSE, the FUSE Calibration Pipeline +# +# Introduction to CalFUSE v3.2 +# +# Created 02/03/2004 +# Van Dixon +# +# History: +# 03/05/2004 Update for v3.0.5. +# Change name of POTHOLE column to QUALITY. +# 04/01/2004 Update for v3.0.6. +# Pipeline now runs on Linux and works on HIST data. +# Default output binning reduced to 0.013 A. +# 05/05/2004 Update for v3.0.7. +# Fixed bug in initial spectral-centroiding routine. +# Extraction routine now uses the same algorithm to +# compute the spectral, weights, and bkgd arrays. +# Modified boxcar extraction to improve background +# estimate. +# 08/20/2004 Update for v3.0.7 release. +# Pipeline now runs on Mac OS X 10.2 and higher. +# Screening now preceeds aperture centroiding. +# Raised minimum pulse height to 2 for all segments. +# 01/21/2005 Add a note about reading the new extracted +# spectral files into IDL. +# 04/19/2005 Update for v3.1.0 release. +# 06/06/2005 Update for v3.1.1 release. +# 06/10/2005 Clarify discussion of spectral file format. +# 06/15/2005 Update for v3.1.2 release. +# 06/24/2005 Add instructions for generating new jitter files. +# 07/12/2005 Modify instructions for generating new jitter files. +# 07/21/2005 Add information about post-processing tools. +# 09/07/2005 Update for v3.1.3 release. +# 12/02/2005 Update for v3.1.5 release. +# 12/03/2005 New changes to cf_mirror_motion and cf_grating_motion +# 01/24/2006 Update for v3.1.6 release. +# 02/02/2006 Update for v3.1.7. +# 05/24/2006 Update for v3.1.8. +# 11/08/2006 Update for v3.2.0. +# 01/15/2007 Move FIFO-overflow correction to cf_convert_to_farf. +# 08/24/2007 Update for v3.2.1. +# 02/15/2008 Update for v3.2.2. +# 12/05/2008 Update for v3.2.3. +# + + +I. Introduction + + CalFUSE v3.2.3 is the latest version of the FUSE data-reduction + pipeline. This package includes a new set of calibration files and + support for Linux 64-bit and Solaris 10 machines. + + For complete details about the program, see the paper, + "CalFUSE v3: A Data-Reduction Pipeline for the Far Ultraviolet + Spectroscopic Explorer" by Dixon et al. (2007) + (http://adsabs.harvard.edu/abs/2007PASP..119..527D). It describes + the CalFUSE pipeline, the instrument calibrations upon which it is + based, and the format of the resulting calibrated data files. + + +II. Recent Improvements + + New in CalFUSE v3.1.5 + + Bad-Pixel Correction: A new routine, cf_screen_bad_pixels, flags + photon events falling in known bad-pixel regions. + + Histogram Mode: For data obtained in HIST mode, + cf_count_rate_y_distort must use a single count-rate value for + the entire exposure. To better estimate it, we replace the + time-dependent FEC-rate array with its weighted mean value. + Rather than using different HIST_PAD values for each aperture, + cf_extraction_limits now pads apertures by 8 pixels (top and + bottom). + + Jitter Correction: To improve the jitter-correction algorithm, we + removed the data-screening functions from cf_satellite_jitter and + moved them to a new routine, cf_screen_jitter. + + New in CalFUSE v3.1.6 + + Burst Correction: Because cf_screen_bursts attempts to exclude + airglow photons from the calculated background, these photons must + be flagged before the routine is called. To this end, + cf_screen_airglow is now the first of the screening routines. + + Background Models: The model background consists of a + spatially-uniform component and a scattered-light image. As a + result of changes introduced in CalFUSE v3.1.3, the scattered-light + component was over-estimated, because the data were summed over a + larger region of the detector than the scattered-light image. Now, + the same limits are applied to both data and models. + + New in CalFUSE v3.1.7 + + Spectral Centroids: We tightened the limits over which + cf_find_spectra computes the spectral centroid to prevent a bright + star in a nearby aperture or the enhanced background near the + detector edge from pulling the extraction window off center. In + both cf_compute_y_centroid and cf_find_spectra, we returned the + parameter-file keywords EMAX_LIF and EMAX_SIC to their original + behavior: if the centroid differs from the default value by more + than this limit, the default value is used. + + New in CalFUSE v3.1.8 + + Astigmatism and Dispersion: The routine + cf_astigmatism_and_dispersion was divided into two programs, + cf_astigmatism and cf_dispersion. + + Fewer Warnings: The pipeline no longer issues WARNING messages + when a raw or intermediate data file is empty, when the jitter file + is missing, when the detector voltage is low, or when it cannot + perform optimal extraction. + + Fewer Bad Spectra: The program cf_extract_spectra no longer + discards (that is, sets to zero the flux and error arrays of) + spectra with non-zero values of EXP_STAT. + + New in CalFUSE v3.2.0 + + Time-Dependent X and Y Distortions: It turns out that the X and Y + coordinates computed by the detector electronics for a particular + spectral feature drift slowly with time. The new routine + cf_time_xy_distort corrects for this effect. + + Grating Motion: The grating-motion correction has been revised to + better correct the zero point of the wavelength scale. + + Jitter Files: Over the years, FUSE engineers have repeatedly + modified the spacecraft-control software, but the routine that + generates jitter files has not been kept up to date. As a result, + the program was not using all available information to determine + the quality and value of pointing errors. We have modified the + code to make use of this information. As a result, the meaning of + the jitter-file TRKFLG array has changed: values between 1 and 5 + reflect increasing levels of confidence in the quality of reported + pointing errors, a value of 0 indicates that pointing telemetry is + missing, and a value of -1 says that the pointing is unknown but + likely to be bad. Jitter files generated with the new routine + receive a version number >= 3.0. The use of old jitter files with + the new software is likely to yield unsatisfactory results. If you + have the housekeeping files, you can generate jitter files that are + consistent with the new pipeline. To do it, delete (or hide) the + old jitter files, then type + + prompt> cf_jitter P9990101001hskpf.fit P9990101001jitrf.fit + + for each exposure. Run the pipeline as usual. + + Jitter Correction: The jitter routines cf_screen_jitter and + cf_satellite_jitter have been updated to take advantage of the + information present in the new jitter files, and three new keywords + have been added to the parameter file. Times for which the X or Y + pointing errors are greater than DX_MAX or DY_MAX (default is 30") + are flagged as bad. Only pointing errors with associated tracking + flag values >= TRKFLG (default is 3) are considered reliable. + + FIFO Overflow: Before, the screening routines flagged times when + the detector count rate went to zero because of FIFO overflows. + This technique underestimated the actual target flux. Now, we + modify the IDS dead-time correction to account for photon losses + due to FIFO overflows. + + New in CalFUSE v3.2.1 + + Jitter Correction: We have modified the program cf_jitter, which + constructs jitter files, to be more robust when presented with + weird pointing data. + + SAA Contours: The size of the South Atlantic Anomaly varies on + timescales of weeks. If you find that the default contours (in the + file saac004.fit) are too small, causing times with elevated + background rates to be flagged as good, you can switch to the + smaller set of contours in the file saac005.fit by modifying the + file master_calib_file.dat. + + New in CalFUSE v3.2.2 + + New Platforms: CalFUSE now runs on 64-bit machines running Linux + and Sun workstations running Solaris v10. See the file + INSTALLING_CalFUSEv3.2.2 for installation details. + + We have used data from the last few months of the mission to + produce final versions of the PHAH_CAL, STIM_CAL, and PHAX_CAL + files. + + New in CalFUSE v3.2.3 + + The final version of the pipeline includes updates needed for the + final processing of the FUSE archive. First, airglow exposures get + special treatment: data taken close to the earth limb are flagged + but not rejected. Airglow exposures are ignored by cf_combine and + idf_combine unless the -a flag is set. Second, the usual limits on + the spectral centroids are not applied to HIST data, because + spectra from other apertures are not present to confuse the + centroiding algorithm. + + +III. Overview of Pipeline + + The following modules are called by the shell script calfuse.csh: + + cf_ttag_init, cf_hist_init + Converts raw-data file into an IDF containing photon-event + list, GTI's, and timeline table. Histogram data are converted + to a pseudo-time-tag format. + + cf_convert_to_farf + Corrects for detector deadtime. Transforms photon coordinates + into the FARF (flight alignment reference frame). + + cf_screen_photons + Checks data quality. Assigns status flag to each photon. + + cf_remove_motions + Corrects for mirror, grating, FPA, and spacecraft motions. + + cf_assign_wavelength + Applies astigmatism and Doppler corrections. + Assigns wavelength to each photon. + + cf_flux_calibrate + Converts WEIGHT to ERG/CM2 for each photon. + + cf_bad_pixels + Applies image-motion corrections to bad-pixel map. + + cf_extract_spectra + Extracts LiF and SiC spectra only for target aperture. + Wavelength array is user defined; default spacing is 0.013 A. + + +IV. Installing and Running the Pipeline + + CalFUSE is now available for Macs running OS X 10.2 and higher, + 64-bit Linux machines, and Sun workstations running Solaris 10. + + Please see the document INSTALLING_CalFUSEv3.2.2 for instructions. + + For both TTAG and HIST data, the command is + + prompt> calfuse P99901010011attagfraw.fit + prompt> calfuse P99901010011ahistfraw.fit + + The pipeline expects to find all data files (*raw.fit, *jitrf.fit, + *hskpf.fit) in the current directory. It operates on one detector + segment at a time. + + CalFUSE v3 produces the following output files: an intermediate + data file (IDF), discussed below; a bad-pixel map (BPM), with a + format similar to the IDF; two extracted spectral files, one for + each of the LiF and SiC channels; and (if IDL is installed on your + machine) a pair of GIF or JPEG files, one an image of the detector + and the other a count-rate plot. + + +V. The Intermediate Data File (IDF) + + The photon-list files consist of three FITS binary tables. The + first contains the photon events themselves. The pipeline does not + discard any events, but uses a series of flags to indicate whether + particular photons violate pulse-height limits, limb-angle + constraints, etc. The IDL tool cf_edit (discussed below) allows + users to modify these flags and combine IDF files from multiple + exposures. + + The second extension to the data files is a list of good-time + intervals (GTI's). They are not used by the extraction routine, + but may prove helpful to pipeline users. + + The third extension is called a timeline table. For each second + during the exposure, it lists a dozen parameters, including count + rate, day-night status, and detector voltage. The pipeline uses + this list to set the status flags for each photon. + + Note: because of the new file format employed by IDF files, + extensions 1 and 3 must be read using the /fscale keyword. + + idl> a=mrdfits('P99901010011attagfidf.fit',1,/fscale) + idl> help,a,/str + + Elements of individual arrays must be addressed using the syntax + + idl> print,a.time[3:30] -- not a[3:30].time + + For details about the format of the IDF, please see the document + + [calfuse_directory]/v3.1/src/README_FILES/IDF_Format.txt + + +VI. Manipulating the IDF with cf_edit + + CF_EDIT is an Interactive Data Language (IDL) visualization tool + for the examination and modification of FUSE IDF files containing + flux- and wavelength-calibrated photon-event lists. Users without + IDL licenses may use the IDL "Virtual Machine" version of the + tool for free. Complete instructions for installing and using + cf_edit are available at this URL: + + http://fuse.pha.jhu.edu/analysis/fuse_idl_tools.html + + More information on the IDL Virtual Machine is available here: + + http://www.rsinc.com/idlvm/index.asp + + +VII. The Output Spectral File + + The format of the output spectral files is somewhat changed from + earlier versions of CalFUSE. + + float WAVE Wavelength (Angstroms) + float FLUX Flux (erg/cm2/s/A) + float ERROR Gaussian errors (erg/cm2/s/A) + int COUNTS Raw counts in extraction window + float WEIGHTS Raw counts corrected for deadtime, etc. + float BKGD Estimated background in extraction window + short QUALITY Percentage of window used for extraction + + Note that the QUALITY array no longer lists the number of Y pixels + that contribute to each output X pixel. Instead, it is the fraction + of the extraction window considered to contain valid data, expressed + as a percentage (0 is all bad; 100 is all good). + + Do-it-yourself-ers can use the following recipe to generate a + flux-calibrated spectrum: + + TARGET_COUNTS = WEIGHTS - BKGD + TARGET_FLUX = TARGET_COUNTS * HC / LAMBDA / AEFF / EXPTIME / WPC + + where AEFF = effective area in cm^2 and WPC = size of output pixel in + Angstroms. + +VIII. Additional Files Available from MAST + + CalFUSE produces eight extracted spectral (*fcal.fit) files for + each exposure. We combine them into a set of three + observation-level files for submission to the MAST archive. + Depending on the target and the questions that you are trying to + answer, you may find that these files are of sufficient fidelity + for scientific investigation. Here's a brief description of their + contents: + + ALL: For each channel (LiF 1A, SiC 1A, etc.), we combine data from + all exposures in the observation into a single spectrum. If the + individual spectra are bright enough, we cross correlate and shift + before combining them. If the spectra are too faint, we combine the + individual IDF files and extract a single spectrum to optimize the + background model. The combined spectrum for each channel is stored + in a separate extension. + + Note: The cataloging software used by MAST requires the presence of + an ALL file for each exposure, not just for the entire observation. + We now generate such a file, but it contains no data, only a FITS + file header. The observation-level ALL files discussed above can be + identified by the string "00000all" in their names. + + ANO (all, night-only): Same format as the ALL files, but using only + data obtained during the night-time portion of each exposure. These + files are generated only for TTAG data, and only if EXPNIGHT > 0. + + NVO (National Virtual Observatory): Contains a single spectrum + spanning the entire FUSE wavelength range. The spectrum is + assembled by cutting and pasting segments from the most sensitive + channel at each wavelength. Segments are shifted to match LiF 1A + between 1045 and 1070 E. Columns are WAVE, FLUX, and ERROR and are + stored in a single binary table extension. + +IX. Data-Analysis Tools + + A variety of IDL routines to display and manipulate FUSE data are + available from the FUSE IDL Tools Reference Page: + + http://fuse.pha.jhu.edu/analysis/fuse_idl_tools.html + + Data-analysis tools distributed with the CalFUSE pipeline are + reviewed in the document FUSE Tools in C: + + http://fuse.pha.jhu.edu/analysis/fuse_toolbox.html + + A subset of these programs, designed specifically for the + manipulation of IDF files, is described in the IDF Cookbook: + + http://fuse.pha.jhu.edu/analysis/idfcook/index.html diff --git a/doc/Makefile.am b/doc/Makefile.am new file mode 100644 index 0000000..239796f --- /dev/null +++ b/doc/Makefile.am @@ -0,0 +1,6 @@ +docdir = $(datadir)/doc/@PACKAGE@-@VERSION@ +doc_DATA = FIXING_SELINUX_ISSUES \ + INSTALLING_A_FORTRAN_COMPILER \ + INSTALLING_CalFUSEv3.2.3 \ + INTRO_TO_CalFUSEv3.2.3 \ + pipeline_status.html diff --git a/doc/Makefile.in b/doc/Makefile.in new file mode 100644 index 0000000..0ed656b --- /dev/null +++ b/doc/Makefile.in @@ -0,0 +1,504 @@ +# Makefile.in generated by automake 1.15 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2014 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +VPATH = @srcdir@ +am__is_gnu_make = { \ + if test -z '$(MAKELEVEL)'; then \ + false; \ + elif test -n '$(MAKE_HOST)'; then \ + true; \ + elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ + true; \ + else \ + false; \ + fi; \ +} +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = doc +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/m4/libtool.m4 \ + $(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \ + $(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +DIST_COMMON = $(srcdir)/Makefile.am $(am__DIST_COMMON) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/src/include/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +SOURCES = +DIST_SOURCES = +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; +am__install_max = 40 +am__nobase_strip_setup = \ + srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` +am__nobase_strip = \ + for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" +am__nobase_list = $(am__nobase_strip_setup); \ + for p in $$list; do echo "$$p $$p"; done | \ + sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ + $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ + if (++n[$$2] == $(am__install_max)) \ + { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ + END { for (dir in files) print dir, files[dir] }' +am__base_list = \ + sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ + sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' +am__uninstall_files_from_dir = { \ + test -z "$$files" \ + || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ + || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ + $(am__cd) "$$dir" && rm -f $$files; }; \ + } +am__installdirs = "$(DESTDIR)$(docdir)" +DATA = $(doc_DATA) +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +am__DIST_COMMON = $(srcdir)/Makefile.in +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +ALLOCA = @ALLOCA@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AR = @AR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DLLTOOL = @DLLTOOL@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +F77 = @F77@ +FFLAGS = @FFLAGS@ +FGREP = @FGREP@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ +MAKEINFO = @MAKEINFO@ +MANIFEST_TOOL = @MANIFEST_TOOL@ +MKDIR_P = @MKDIR_P@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PKG_CONFIG = @PKG_CONFIG@ +PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ +PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ +RANLIB = @RANLIB@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +VERSION = @VERSION@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_AR = @ac_ct_AR@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +ac_ct_F77 = @ac_ct_F77@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +cfitsio_CFLAGS = @cfitsio_CFLAGS@ +cfitsio_LIBS = @cfitsio_LIBS@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = $(datadir)/doc/@PACKAGE@-@VERSION@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +doc_DATA = FIXING_SELINUX_ISSUES \ + INSTALLING_A_FORTRAN_COMPILER \ + INSTALLING_CalFUSEv3.2.3 \ + INTRO_TO_CalFUSEv3.2.3 \ + pipeline_status.html + +all: all-am + +.SUFFIXES: +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign doc/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign doc/Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs +install-docDATA: $(doc_DATA) + @$(NORMAL_INSTALL) + @list='$(doc_DATA)'; test -n "$(docdir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(docdir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(docdir)" || exit 1; \ + fi; \ + for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + echo "$$d$$p"; \ + done | $(am__base_list) | \ + while read files; do \ + echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(docdir)'"; \ + $(INSTALL_DATA) $$files "$(DESTDIR)$(docdir)" || exit $$?; \ + done + +uninstall-docDATA: + @$(NORMAL_UNINSTALL) + @list='$(doc_DATA)'; test -n "$(docdir)" || list=; \ + files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ + dir='$(DESTDIR)$(docdir)'; $(am__uninstall_files_from_dir) +tags TAGS: + +ctags CTAGS: + +cscope cscopelist: + + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(DATA) +installdirs: + for dir in "$(DESTDIR)$(docdir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-libtool mostlyclean-am + +distclean: distclean-am + -rm -f Makefile +distclean-am: clean-am distclean-generic + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: install-docDATA + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-generic mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-docDATA + +.MAKE: install-am install-strip + +.PHONY: all all-am check check-am clean clean-generic clean-libtool \ + cscopelist-am ctags-am distclean distclean-generic \ + distclean-libtool distdir dvi dvi-am html html-am info info-am \ + install install-am install-data install-data-am \ + install-docDATA install-dvi install-dvi-am install-exec \ + install-exec-am install-html install-html-am install-info \ + install-info-am install-man install-pdf install-pdf-am \ + install-ps install-ps-am install-strip installcheck \ + installcheck-am installdirs maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-generic \ + mostlyclean-libtool pdf pdf-am ps ps-am tags-am uninstall \ + uninstall-am uninstall-docDATA + +.PRECIOUS: Makefile + + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/doc/pipeline_status.html b/doc/pipeline_status.html new file mode 100644 index 0000000..be15d28 --- /dev/null +++ b/doc/pipeline_status.html @@ -0,0 +1,3515 @@ +<!doctype html public "-//w3c//dtd html 4.0 transitional//en"> +<html> +<head> + <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> + <meta name="GENERATOR" content="Mozilla/4.6 [en] (X11; U; SunOS 5.7 sun4u) [Netscape]"> + <meta name="CREATED" content="20000121;18144100"> + <meta name="CHANGED" content="20000124;16081300"> + <title>CALFUSE Pipeline Status</title> +</head> +<body bgcolor="#FFFFFF"> + +<h1> +CalFUSE Pipeline Status</h1> +<b>Final pipeline version is 3.2.3, dated December 5, 2008.</b> + +<p STYLE="margin-bottom: 0in">Latest updates: + +<p>December 5, 2008 +<br>Van Dixon +<BR>v3.2/src/libcf/cf_calculate_y_centroid.c +<BR>v3.2/src/libcf/cf_find_spectra.c +<BR>v3.2/src/libcf/cf_screen_jitter.c + +<P> +In HIST mode, there are no spectra in other apertures to cause +confusion, so we need not require that the target centroid lie within X +pixels of either the airglow centroid or the tabulated centroid. Both +cf_find_spectra.c and cf_calculate_y_centroid.c were modified to effect +this change. + +<P> +Modified cf_screen_jitter.c so that the jitter correction is not +applied to ERO observations of Jupiter (program X006). + +<P> +<hr WIDTH="100%"> + +<p>August 22, 2008 +<br>Van Dixon + +<P> +<BR>v3.2/include/calfuse.h +<BR>v3.2/src/fuv/cf_bad_pixels.c +<BR>v3.2/src/fuv/cf_screen_photons.c +<BR>v3.2/src/libcf/cf_apply_filters.c +<BR>v3.2/src/libcf/cf_fuv_init.c +<BR>v3.2/src/libcf/cf_screen_jitter.c +<BR>v3.2/src/libcf/cf_set_photon_flags.c +<BR>v3.2/src/analysis/cf_combine.c +<BR>v3.2/src/analysis/cf_xcorr.c +<BR>v3.2/src/analysis/idf_combine.c +<BR>v3.2/src/analysis/cf_make_all_obs.csh +<BR>v3.2/src/analysis/cf_make_900_obs.csh + +<P> +I've modified CalFUSE to treat bright-earth and airglow observations +differently than before. Here are the details: +<P> +When creating the IDF files for bright-earth observations (programs +M106 and S100) or 900-level airglow exposures, CalFUSE sets the header +keyword EXP_STAT = 2. For 900-level exposures, the SRC_TYPE is set to +EE, and the following warning is written to the file header: +"Airglow exposure. Not an astrophysical target." +<P> +The pipeline then processes the file as usual. In particular, the +limb-angle flag is set in the timeline table (extension 3 of the IDF), +and the "Time with low limb angle" is written to the file header. +However, if EXP_STAT = 2, the following things change: + +<UL> +<LI>no jitter correction is performed; +<LI>when the time-dependent flags are copied from the timeline + table to the individual photons, the limb-angle flag is masked + out; +<LI>when the good-time intervals and exposure time are + calculated, the limb-angle flag is ignored. +</UL> + +<P> +The extracted spectra include photons obtained at low limb angles. The +detector-image plots do, too. But the count-rate plots indicate times +when the line of sight passes below the limb-angle limit. +<P> +For programs M106 and S100, all of the data are included in the +observation-level ALL, ANO, and NVO files. For all other programs, +900-level airglow exposures are excluded from the sum. A new +observation-level file is produced: a single quick-look (gif) plot +showing the summed spectrum from all of the 900-level exposures in the +observation. It has a name like M112580100900specttagf.gif. + +<P> +Update version number to v3.2.3. + +<P> +<hr WIDTH="100%"> + +<p>April 11, 2008 +<br>Van Dixon +<BR>v3.2/src/analysis/cf_xcorr.c +<BR>v3.2/src/analysis/cf_combine.c +<BR>v3.2/src/analysis/cf_make_all_obs.csh + +<P> +We've changed the logic used to combine individual exposures into +observation-level files for data obtained in HIST mode. If the target +is too faint to perform a cross-correlation, but is still in the slit +(i.e., its flux is within 50% of the reference spectrum), add the +spectra using a shift of zero. If an exposure suffers a limb-angle or +SAA violation, include it anyway, assuming that HIST targets are +bright enough that the additional background flux is not a problem. + +<P> +<hr WIDTH="100%"> + +<p>March 21, 2008 +<br>Van Dixon +<BR>v3.2/src/libcf/cf_find_spectra.c + +<P> +In HIST mode, there are no spectra in other apertures to cause +confusion, so we need not require that the target centroid lie +within 30 pixels of the expected value. + +<P> +<hr WIDTH="100%"> + +<p>Feb 22, 2008 +<br>Benjamin Ooghe +<BR>INSTALLING_CalFUSEv3.2.2 +<BR>INSTALLING_A_FORTRAN_COMPILER +<BR>FIXING_SELINUX_ISSUES + +<P>Updated installation information. + +<P> +<BR>v3.2/bin/calfuse.sh +<BR>v3.2/bin/cfsetup.sh +<BR>v3.2/bin/cfsetup.csh + +<P>Added scripts to set environment variables in Bourne-based shells +(sh and bash) for systems without CSH and automated the setting of the +shell path. + +<P> +<BR>v3.2/src/configure.linux +<BR>v3.2/src/configure.linux64 +<BR>v3.2/src/configure.macosx +<BR>v3.2/src/configure.solaris +<BR>v3.2/src/cfitsio/configure +<BR>v3.2/src/Makefile.Linux +<BR>v3.2/src/Makefile.Linux64 +<BR>v3.2/src/Makefile.MacOSX +<BR>v3.2/src/analysis/Makefile.Linux +<BR>v3.2/src/analysis/Makefile.Linux64 +<BR>v3.2/src/analysis/Makefile.MacOSX +<BR>v3.2/src/analysis/idf_combine.c +<BR>v3.2/src/analysis/cf_coadd.c +<BR>v3.2/src/analysis/cf_arith.c +<BR>v3.2/src/analysis/cf_combine.c +<BR>v3.2/src/analysis/cf_pack.c +<BR>v3.2/src/cal/jitter/Makefile.Linux +<BR>v3.2/src/cal/jitter/Makefile.Linux64 +<BR>v3.2/src/cal/jitter/Makefile.MacOSX +<BR>v3.2/src/cal/jitter/cf_jitter.c +<BR>v3.2/src/cal/jitter/cf_jitter_diag.c +<BR>v3.2/src/fes/Makefile.Linux +<BR>v3.2/src/fes/Makefile.Linux64 +<BR>v3.2/src/fuv/Makefile.Linux +<BR>v3.2/src/fuv/Makefile.Linux64 +<BR>v3.2/src/fuv/Makefile.MacOSX +<BR>v3.2/src/fuv/cf_gainmap.c +<BR>v3.2/src/fuv/cf_countmap.c +<BR>v3.2/src/libcf/Makefile.Linux +<BR>v3.2/src/libcf/Makefile.Linux64 +<BR>v3.2/src/libcf/Makefile.MacOSX +<BR>v3.2/src/libcf/cf_idf_io.c +<BR>v3.2/src/slalib/mk +<BR>v3.2/src/slalib/mk.sv +<BR>v3.2/src/slalib/sla_source.tar + +<P>Updated configure files and Makefiles for all systems in order to +compile with more different fortran compilers (f77, f90, g77, gfortran) +and on recent systems (Solaris 10, recent Linux, Mac OS X 10.4) +including 64-bit architecture machines. This required the modification +of source files to correct bad int/long declarations that cause +problems on 64-bit architectures, on Solaris 10 systems, and on some +fortran compilers. + +<P> +<BR>v3.2/include/calfuse.h +<BR>v3.2/src/libcf/cf_fes_proc_update.c +<BR>v3.2/src/libcf/cf_fes_proc_check.c + +<P>Fixed warning messages from GCC compiler (missing brackets and +unused symbols). + +<P> +<BR>v3.2/src/analysis/cf_make_all_obs.csh + +<P>Use airglow spectra when they are the only ones available. + +<P> +<BR>v3.2/src/analysis/cf_nvo.c + +<P>Fixed memory problem causing occasional bad values in the NVO flux arrays. +In copy_spec, the shift+start value was sometimes negative, causing the +routine to read negative indexes in the flux and error arrays. Also, +the final values of the flux_nvo and error_nvo arrays weren't always +written. + +<P> +<BR>v3.2/src/fuv/cf_bad_pixels.c + +<P>In cf_generate_pseudo_photons, verify for each fill-data event that +the LOCATION_SHLD flag is not set to ensure that it does not +fall outside of the active area of the detector. + +<P> +<BR>v3.2/src/libcf/cf_thermal_distort.c + +<P>In cf_estimate_drift_coefficients, set max value of index to jmax-1 +rather than jmax. + + +<P> +<hr WIDTH="100%"> + +<p>February 22, 2008 +<br>Van Dixon +<BR>v3.2/src/fuv/cf_convert_to_farf.c +<BR>v3.2/src/fuv/cf_flux_calibrate.c +<BR>v3.2/src/fuv/cf_ttag_init.c +<BR>v3.2/src/libcf/cf_modify_hist_pha.c +<BR>v3.2/src/libcf/cf_screen_jitter.c +<BR>v3.2/src/libcf/cf_set_good_time_intervals.c + +<P> +Modified cf_convert_to_farf to write out the new PHA values assigned +by cf_modify_hist_pha. + +<P> +Cleaned up i/o in cf_flux_calibrate. + +<P> +Added -e flag to cf_ttag_init. It sets the header keyword HKEXISTS +to YES in the output IDF file. + +<P> +In cf_modify_hist_pha, fixed bug in loop through MJD array. + +<P> +In cf_screen_jitter, don't apply jitter correction to observations +taken after the spacecraft lost pointing control. + +<P> +Changed malloc to cf_malloc in cf_set_good_time_intervals. + +<P> +Update version number to v3.2.2. + +<P> +<hr WIDTH="100%"> + +<br> +<p>May 18, 2007 +<br>Van Dixon +<BR>v3.2/src/libcf/cf_init_support.c + +<P> +If HV array in HSKP file consists of a single 0 followed by all -1's, +use header info to populate timeline table. Change name of subroutine +fill_hv_array to hv_from_hskp and add hv_from_header. + +<P> +Update version number to v3.2.1. + +<P> +<hr WIDTH="100%"> + +<p>April 7, 2007 +<br>Van Dixon +<BR>v3.2/src/fuv/cf_bad_pixels.c + +<P> +Within cf_bad_pixels, we scale nmax, the program's guess at the number +of bad pixels it will have to deal with, by 1.5 to help prevent array +overflows. To make warning messages more meaningful, we call +cf_error_init after each call to cf_extraction_limits and make +CF_PRGM_ID and CF_VER_NUM static variables. + +<P> +This is the release version of CalFUSE v3.2.0. + +<P> +<hr WIDTH="100%"> + +<p>March 29, 2007 +<br>Van Dixon +<BR>v3.2/src/libcf/cf_init_support.c +<BR>v3.2/src/cal/jitter/cf_jitter.c + +<P> +On error, cf_check_digitizer now sets EXP_STAT flag to -2, rather than +-999, to be more consistent with cf_hist_init. + +<P> +We modified cf_jitter to handle the time period (in March 2007) when +the ACS telemetry rate was cut in half and generally made the code +more robust. + +<P> +<hr WIDTH="100%"> + +<br> +<p>March 23, 2007 +<br>Van Dixon +<BR>v3.2/src/fuv/cf_hist_init.c +<BR>v3.2/src/libcf/cf_init_support.c +<BR>v3.2/src/libcf/cf_screen_jitter.c +<BR>v3.2/src/libcf/cf_satellite_jitter.c + +<P> +In cf_hist_init, set EXP_STAT to -1 if a raw hist file contains no +extensions. Treat the limits of the active area as good pixels. + +<P> +In cf_init_support, give a more detailed error message if the +housekeeping file is not usable. + +<P> +In cf_screen_jitter and cf_satellite_jitter, calculate time_diff (the +offset between the jitter and IDF versions of EXPSTART) once, rather +than each time it's used. + +<br> +<p>March 20, 2007 +<br>Van Dixon +<BR>v3.2/src/fuv/cf_bad_pixels.c + +<P> +In the subroutine cf_combine_pothole_data, if an entire dead spot falls +outside of the aperture, skip it and move on to the next one. + +<P> +<hr WIDTH="100%"> + +<p>March 7, 2007 +<br>Van Dixon +<BR>v3.2/src/libcf/cf_init_support.c +<BR>v3.2/src/libcf/cf_velang.c +<BR>v3.2/src/libcf/space_vel.c +<BR>v3.2/include/calfuse.h v1.81 + +<P> +The subroutine space_vel used a convoluted scheme to compute what +is essentially a dot product. I simplified the code, deleted an +argument, and modified the subroutines that call it. + +<P> +This is version 3.2.0 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>February 13, 2007 +<br>Van Dixon +<BR>v3.2/src/fuv/cf_remove_motions.c + +<BR>v3.2/src/libcf/cf_fifo_dead_time.c +<BR>v3.2/src/libcf/cf_init_support.c + +<P> +When writing the LiF and SiC count rate arrays to the IDF file, +cf_remove_motions crashed if the array values were too large to be +stored as unsigned integers. As such enormous values are always wrong, +they are now set to zero. + +<P> +Sometimes, the header keyword TTPERIOD is erroneously set to 0. +If so, cf_init_support and cf_fifo_dead_time now set it to 1.0, +the most likely value. + +<P> +<hr WIDTH="100%"> + +<p>January 2, 2007 +<br>Van Dixon +<BR>v3.2/src/fuv/cf_screen_photons.c +<BR>v3.2/src/fuv/cf_convert_to_farf.c +<BR>v3.2/src/fuv/cf_remove_motions.c + +<BR>v3.2/src/libcf/cf_apply_dead_time.c +<BR>v3.2/src/libcf/cf_fifo_dead_time.c +<BR>v3.2/src/libcf/cf_target_count_rate.c +<BR>v3.2/src/libcf/pole_ang.c +<BR>v3.2/src/libcf/cf_velang.c +<BR>v3.2/src/libcf/cf_screen_high_voltage.c +<BR>v3.2/src/libcf/cf_satellite_jitter.c +<BR>v3.2/src/libcf/cf_grating_motion.c +<BR>v3.2/src/libcf/cf_time_xy_distort.c +<BR>v3.2/src/libcf/cf_init_support.c +<BR>v3.2/src/libcf/cf_set_photon_flags.c + +<BR>v3.2/src/cal/jitter/cf_jitter.c + +<BR>v3.2/src/analysis/cf_combine.c +<BR>v3.2/src/analysis/cf_nvo.c +<BR>v3.2/src/analysis/cf_pack.c +<BR>v3.2/src/analysis/idf_combine.c + + +<P> +To fix a bug in our correction for photon-event losses to FIFO +overflows, we modified the subroutine cf_screen_fifo_overflow, renamed +it cf_fifo_dead_time, and moved it from cf_screen_photons to +cf_convert_to_farf. The subroutine cf_apply_dead_time issues a warning +if DET_DEAD > 1.5, rather than TOT_DEAD. Because we no longer use +the HV status flag to denote FIFO overflows, mention of the FIFO flag +was removed from cf_set_photon_flags. Within cf_convert_to_farf, we +now set the header keywords DET_DEAD, IDS_DEAD, and TOT_DEAD to unity +by default. + +<P> +Within cf_remove_motions, we now treat the LiF and SiC count-rate +arrays as floats. We pass the WEIGHT array to cf_target_count_rate, +so that it returns dead-time corrected count rates. If these count +rates are too large to store as shorts, we use the TSCALE and TZERO +keywords to store them as unsigned shorts. For HIST data, we scale +the default LiF and SiC rates (read from the housekeeping file) by +the value of DET_DEAD to account for detector dead-time losses. + +<P> +The new subroutine pole_ang returns the angle between the orbit pole +and a given RA and DEC. It is called by cf_velang, which populates +the POLEANGL keyword. + +<P> +The subroutine cf_screen_high_voltage no longer sets the EXP_STAT keyword. + +<P> +The subroutine cf_find_spectra has been modified: if the new argument +airglow_centroid is TRUE, then the program uses the airglow lines to +compute the centroid of the target spectrum. To invoke this option, +call cf_remove_motions with the -a flag. + +<P> +The program cf_jitter has been extensively modified. Among other +changes, it can (if necessary) compute the commanded quaternion from +the target coordinates in the housekeeping file header. Values of the +TRKFLG array now range from -1 to 5, with -1 meaning that tracking is +bad, 0 that no information is available, and 1 to 5 representing +increasingly reliable tracking estimates. The subroutines +cf_satellite_jitter and cf_screen_jitter have been modified +accordingly. In particular, the minimum value of TRKFLG that is to be +considered reliable and the X and Y aperture limits are read from the +pipeline parameter file. + +<P> +Both the subroutine cf_grating_motion and the grating-motion +calibration file have been completely revised. The new model depends +on the target's beta and pole angles. An additional set of corrections +tracks long-term drifts in the spectra's X and Y positions. + +<P> +A new subroutine, cf_time_xy_distort, corrects for long-term drifts +in the detector X and Y coordinate scales. It is called by +cf_convert_to_farf. + +<P> +We fixed a bug in the way that cf_init_support constructs the AIC +count-rate array. + +<P> +Lots of little changes in the analysis routines: When selecting which +detector segment to include in the composite spectrum, cf_nvo now +rejects segments with OBSTIME < 10 sec if the entire exposure is > 100 +s. The program idf_combine adds comment fields to the header keywords +WOFFS and WOFFL. The program cf_combine now counts SPEC### and WAVE### +using the variable ngood, rather than nfiles. Finally, we made small +changes to the way that cf_pack copies the SPEC keywords to the output +file header. + + +<P> +<hr WIDTH="100%"> + +<p>June 22, 2006 +<br>Van Dixon +<BR>v3.2/src/fuv/cf_hist_init.c +<BR>v3.2/src/fuv/cf_extract_spectra.c +<BR>v3.2/src/fuv/cf_ttag_init.c +<BR>v3.2/src/libcf/cf_screen_jitter.c +<BR>v3.2/src/libcf/cf_screen_burst.c +<BR>v3.2/src/libcf/cf_optimal_extraction.c +<BR>v3.2/src/libcf/cf_fuv_init.c +<BR>v3.2/src/libcf/cf_error_msg.c + +<P> +The pipeline no longer issues WARNING messages when a raw or +intermediate data file is empty, either because it contains no photons +or because the entire exposure has been flagged as bad; when the jitter +file is missing (though out-of-date jitter files inspire a WARNING); +when the detector voltage is low; and when the pipeline cannot perform +optimal extraction. It issues level 1 verbose messages instead. + +<P> +Now that OPUS has been updated, the variable morekeys has been set to +zero in both cf_hist_init and cf_ttag_init. + +<P> +This is version 3.1.8 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<br> +<p>May 24, 2006 +<br>Van Dixon +<BR>v3.2/src/fuv/cf_extract_spectra.c +<BR>v3.2/src/analysis/cf_combine.c +<BR>v3.2/src/analysis/cf_nvo.c +<BR>v3.2/src/analysis/cf_pack.c +<BR>v3.2/src/analysis/cf_xcorr.c +<BR>v3.2/src/analysis/idf_combine.c +<BR>v3.2/idl/cf_obsplot.pro + +<P> +We modified cf_extract_spectra so that it will no longer discard (that +is, set to zero the flux and errors arrays of) spectra with non-zero +values of EXP_STAT. Those spectra are now rejected by cf_combine, +instead. + +<P> +The program cf_combine has been extensively revised: +it now runs through the input files with a single loop; +it supports the same command-line options as idf_combine; and +it ignores spectra with EXP_STAT != 0 (unless the -a flag is set). + +<P> +Both cf_nvo and cf_xcorr now use the Lyman beta line to align the +spectra of background observations. They use the interstellar O VI and +C II lines to align white dwarf spectra. For BKGD targets, cf_nvo +always selects the channel with the highest effective area, regardless +of its observed flux. The mean flux, used when deciding which segment +to use, is now calculated using the same wavelength regions for each +channel. For PC targets, the O VI lines are not included in the mean +flux calculation. + +<P> +The program cf_pack now writes an index to the various file extensions +to the primary HDU of the output *000all* file. + +<P> +Both cf_combine and idf_combine now write a number of header keywords +as longs, rather than floats. + +<P> +Three changes to cf_obsplot.pro: For BKGD targets, omit flux +comparison when selecting which detector segments to use. Compute mean +flux using same wavelength intervals for each band. For PC targets, +don't include O VI in the calculation of the mean flux. + +<P> +<hr WIDTH="100%"> + +<br>Van Dixon +<BR>v3.2/src/fuv/cf_assign_wavelength.c +<BR>v3.2/src/fuv/cf_bad_pixels.c +<BR>v3.2/src/libcf/cf_astigmatism.c +<BR>v3.2/src/libcf/cf_dispersion.c +<BR>v3.2/src/libcf/cf_apply_dead_time.c +<BR>v3.2/src/libcf/cf_extraction_limits.c +<BR>v3.2/src/libcf/cf_init_support.c +<BR>v3.2/src/libcf/cf_screen_burst.c +<BR>v3.2/src/libcf/cf_screen_fifo_overflow.c +<BR>v3.2/src/libcf/cf_screen_jitter.c +<BR>v3.2/src/libcf/cf_set_photon_flags.c +<BR>v3.2/src/analysis/cf_make_all_obs.csh +<BR>v3.2/src/analysis/cf_nvo.c +<BR>v3.2/src/analysis/cf_pack.c +<BR>v3.2/src/analysis/cf_xcorr.c + +<P> +Divided cf_astigmatism_and_dispersion into two routines, incorporating +astig_check_input_image into the new program cf_astigmatism and +cf_x2lambda into cf_dispersion. Modified cf_assign_wavelength and +cf_bad_pixels to call the new routines. Because cf_astig_farf is not +used, it is no longer defined in calfuse.h or compiled by the +Makefile. + +<P> +Cleaned up i/o in cf_apply_dead_time. + +<P> +For targets observed in HIST mode, cf_extraction_limits.c now pads +apertures by SPECBINY pixels. + +<P> +In cf_init_support, flag as bad all times after final OPUS GTI. + +<P> +In cf_screen_burst, require that the number of windows in subroutine +median_filter be >= 1. +In cf_screen_fifo_overflow, changed length of data_rate array from +nevents to nseconds. +In cf_screen_jitter, screening is now applied to targets observed with +APERTURE = RFPT. +In cf_set_photon_flags, modify header keyword EXP_STAT only if was initially 0. + +<P> +In the analysis directory, modified cf_make_all_obs.csh to be smarter +when deciding whether to cross-correlate spectra or combine IDF files. +Also modified logic for discarding 000 files. In cf_nvo, ignore +segments with OBS_TIME = 0 and allow use of SiC data for 1000-1100 A +region. (Sometimes the LiF channels are not used.) In cf_pack, if a +segment is missing, write an empty image extension to the combined data +file. In cf_xcorr, scale each spectrum to the mean flux of the +reference spectrum. + +<P> +This is version 3.1.8 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>February 3, 2006 +<br>Van Dixon +<BR>v3.2/src/fuv/cf_compute_y_centroid.c +<BR>v3.2/src/fuv/cf_find_spectra.c +<BR>v3.2/src/libcf/cf_scale_bkgd.c +<BR>v3.2/src/fuv/cf_extract_spectra.c + +<P> +We tightened the limits over which cf_find_spectra computes the +spectral centroid to prevent a bright star in a nearby aperture or the +enhanced background near the detector edge from pulling the extraction +window off center. In both cf_compute_y_centroid and cf_find_spectra, +we returned the EMAX_LIF and EMAX_SIC keywords to their original +behavior: if the centroid differs from the default value by more than +this limit, the default value is used. + +<P> +We fixed a bug introduced in the last modification of cf_scale_bkgd +that essentially turned off the background subtraction. + +<P> +We added a command-line flag to cf_extract_spectra that forces the use +of optimal extraction, even for extended sources. + +<P> +This is version 3.1.7 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>January 24, 2006 +<br>Van Dixon +<BR>v3.2/src/fuv/cf_screen_photons.c +<BR>v3.2/src/libcf/cf_scale_bkgd.c + +<P> +Because cf_screen_burst wants to exclude airglow photons from the +calculated background, we must identify them before calling the +routine. To that end, I've made cf_screen_airglow the first of the +screening routines. + +<P> +The model background consists of a spatially-uniform component and a +scattered-light image. The scattered-light component was +over-estimated, because the data count totals were computed using a +larger region of the detector than the scattered-light model totals. +Now, we apply the same limits to both data and models. + +<P> +The program returns a slice of the background that is supposed to match +that covered by the probability array. Limit checks in the subroutine +get_limits prevented the background slice from falling off of the +detector. Sometimes, you want to background slice to fall off of the +detector. In such cases, the limit checks could introduce an unwanted +offset in the model background. We've deleted the limit checks and use +other means to avoid bad index values. + +<P> +This is version 3.1.6 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>January 3, 2006 +<br>Van Dixon +<BR>v3.2/src/libcf/cf_grating_motion.c + +<P> +Correct LiF 1 data for residual zero-point errors in the wavelength scale. + +<P> +<hr WIDTH="100%"> + +<p>December 2, 2005 +<br>Van Dixon +<BR>v3.2/src/libcf/cf_mirror_motion.c + +<P> +cf_mirror_motion now exits without modifying the data if target is an +extended source. + +<P> +<hr WIDTH="100%"> + +<p>December 2, 2005 +<br>Van Dixon +<BR>v3.2/src/libcf/cf_astigmatism_and_dispersion.c +<BR>v3.2/src/libcf/cf_apply_dead_time.c +<BR>v3.2/src/libcf/cf_convert_to_ergs.c +<BR>v3.2/src/libcf/cf_count_rate_y_distort.c +<BR>v3.2/src/libcf/cf_doppler_and_heliocentric.c +<BR>v3.2/src/libcf/cf_extraction_limits.c +<BR>v3.2/src/libcf/cf_fpa_position.c +<BR>v3.2/src/libcf/cf_init_support.c +<BR>v3.2/src/libcf/cf_make_mask.c +<BR>v3.2/src/libcf/cf_optimal_extraction.c +<BR>v3.2/src/libcf/cf_satellite_jitter.c +<BR>v3.2/src/libcf/cf_screen_bad_pixels.c (NEW) +<BR>v3.2/src/libcf/cf_screen_fifo_overflow.c +<BR>v3.2/src/libcf/cf_screen_jitter.c (NEW) +<BR>v3.2/src/fuv/cf_bad_pixels.c +<BR>v3.2/src/fuv/cf_extract_spectra.c +<BR>v3.2/src/fuv/cf_remove_motions.c +<BR>v3.2/src/fuv/cf_screen_photons.c + +<P> +To improve our bad-pixel correction, we've added a new routine, +cf_screen_bad_pixels, which flags photon events falling in known +pothole regions. cf_make_mask now fills gaps in the bad-pixel mask +that open when it is converted from pixels to wavelengths. In the +optimal-extraction algorithm, cf_optimal_extraction now scales the +variance estimate by the bad-pixel mask to better approximate the +observed counts. The main pothole routine, cf_bad_pixels, now uses +cf_x2lambda() and cf_get_potholes(), rather than its own subroutines +that do the same job. Also, it no longer adds random numbers to the +output pixel coordinates -- that's no longer necessary. Finally, +cf_bad_pixels no longer trims potholes at the edges of the +extraction windows. We modified cf_astigmatism_and_dispersion so that +it would not complain when events fall outside of the astig images. + +<P> +We added a test to cf_apply_dead_time to catch bad dead-time values: If +there is no housekeeping file, AND the engineering snapshot times are +bad, AND the mean value of either dead-time array is > 1.5, set the +array to unity and issue a warning. + +<P> +In cf_convert_to_ergs, we changed the effective-area arrays to type +double to match the AEFF_CAL files. + +<P> +For histogram data, cf_count_rate_y_distort must use a single count +rate value for all of the data. To better estimate it, we replace the +time-dependent FEC-rate array with its weighted mean value. + +<P> +To improve our calculation of the Doppler correction, we changed the +variables velocity and doppler to doubles in cf_doppler_and_heliocentric. + +<P> +Rather than using different HIST_PAD values for each aperture, +cf_extraction_limits now always pads the apertures by 8 pixels (top and +bottom) when in HIST mode. + +<P> +We deleted unused variables in cf_fpa_position. + +<P> +More efforts to catch corrupted keywords in cf_init_support: When +the housekeeping file is missing and the engineering snapshot times are +corrupted, we use EXPSTART and EXPEND to estimate eng_time. If EXPEND is +corrupted, we use EXPTIME. + +<P> +To improve the jitter-correction algorithm, we've removed the +data-screening functions from cf_satellite_jitter and moved them to a +new routine, cf_screen_jitter. The modules cf_remove_motions and +cf_screen_photons have been modified accordingly. + +<P> +We caught a bug in cf_screen_fifo_overflow: It was using the +RATE_LIF and RATE_SIC arrays to estimate the raw count rate, but those +arrays are populated from the housekeeping file and do not reflect data +losses due to FIFO overflows. Now we calculate the count rate across +the entire detector directly from the photon-event data. + +<P> +We added a flag to cf_extract_spectra that allows the user to disable +optimal extraction from the command line. + +<P> +This is version 3.1.5 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>September 19, 2005 +<br>Van Dixon +<BR>v3.1/src/libcf/cf_read_fpa_pos.c (RESTORED) + +<P> +Had to restore cf_read_fpa_pos, as it's called by ttag_combine. + +<P> +This is version 3.1.3 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>September 7, 2005 +<br>Van Dixon +<BR>v3.1/src/analysis/cf_arith.c (RENAMED) +<BR>v3.1/src/analysis/cf_coadd.c +<BR>v3.1/src/analysis/cf_combine.c +<BR>v3.1/src/analysis/cf_make_all_exp.c (NEW) +<BR>v3.1/src/analysis/cf_nvo.c +<BR>v3.1/src/analysis/cf_pack.c +<BR>v3.1/src/analysis/cf_xcorr.c +<BR>v3.1/src/analysis/getshift.c +<BR>v3.1/src/analysis/modhead.c +<BR>v3.1/src/libcf/cf_init_support.c +<BR>v3.1/src/libcf/cf_fpa_position.c +<BR>v3.1/src/libcf/cf_read_fpa_pos.c (DELETED) +<BR>v3.1/src/libcf/cf_screen_burst.c +<BR>v3.1/src/libcf/cf_write_extracted_spectrum.c + +<P> +We are required to provide MAST an <b>all</b> file for each exposure and +one set of <b>all</b>, <b>ano</b>, and <b>nvo</b> files per observation. +These files are created by cf_coadd, which has been completely re-written. +It calls cf_make_all_exp for each exposure and cf_make_all_obs.csh once +per observation. The new program cf_make_all_exp copies the primary HDU +of the channel with the longest EXPTIME into an otherwise empty file. +cf_nvo now sets the keyword NEXTEND back to 1. +In cf_pack, the keyword COMB_COR is set to COMPLETE. + +<P> +The name of cf_arith3 has been changed back to cf_arith. +If called with no arguments, cf_arith, cf_combine, cf_xcorr, and getshift +don't return an error, just a "usage" message. +If the input list given to cf_combine contains only file names (no shifts), +the program assumes that all shifts are zero. +The programs cf_xcorr and cf_combine have been modified +to use the same sign convention for spectral shifts as FUSE_REGISTER. +The program modhead now accepts multi-word strings as keyword values. + +<P> +In cf_init_support, use LWRS background limits for RFPT observations. +In cf_fpa_position, correct for both X and Z displacement of FPA's. +Delete call to cf_read_fpa_pos. +In cf_screen_burst, ignore photons with arrival times greater than MAX_EXPTIME. +In cf_write_extracted_spectrum, delete FITS_write_date from cf_copy_hist_header. + +<P> +<hr WIDTH="100%"> + +<p>July 12, 2005 +<br>Van Dixon +<BR>v3.1/src/analysis/cf_combine.c +<BR>v3.1/src/analysis/cf_nvo.c +<BR>v3.1/src/analysis/cf_pack.c +<BR>v3.1/src/cal/jitter/cf_jitter.c +<BR>v3.1/src/libcf/cf_satellite_jitter.c + +<P> +In cf_combine, we use fgets to read the input file and assume that pix_shift +is an integer. +In cf_nvo, we modify the cross-correlation routine to use LiF 2B as the +wavelength standard if header keyword FESCENT is set to FES B. +In cf_pack, we set the header keyword COMB_COR to COMPLETE. + +<P> +cf_jitter writes a new keyword, JIT_VERS, to the header of each jitter +file. If this keyword is missing or is less than 2, +cf_satellite_jitter now warns that the jitter file format is out +of date, which may result in the rejection of good data. + +<P> +<hr WIDTH="100%"> + +<p>June 16, 2005 +<br>Van Dixon +<BR>v3.1/src/libcf/cf_rebin_probability_array.c +<BR>v3.1/src/libcf/cf_scale_bkgd.c +<BR>v3.1/src/fuv/cf_extract_spectra.c +<BR>v3.1/include/calfuse.h v1.71 + +<P> +A bug in the spectral-extraction subroutines caused CalFUSE always to +use the smaller, point-source extraction window, even for extended +sources. This could lead to an underestimate of the flux for extended +sources. The pipeline now uses either the point-source or +extended-source aperture, as appropriate. + +<P> +This is version 3.1.2 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>June 8, 2005 +<br>Van Dixon +<BR>v3.1/src/analysis/cf_combine.c +<BR>v3.1/src/analysis/cf_make_all.csh +<BR>v3.1/src/analysis/cf_nvo.c +<BR>v3.1/src/analysis/cf_pack.c +<BR>v3.1/src/analysis/cf_xcorr.c +<BR>v3.1/src/analysis/extract_jitter.c +<BR>v3.1/src/analysis/idf_combine.c +<BR>v3.1/src/libcf/cf_calculate_y_centroid.c +<BR>v3.1/src/libcf/cf_find_spectra.c +<BR>v3.1/src/libcf/cf_idf_io.c +<BR>v3.1/src/libcf/cf_modify_hist_pha.c +<BR>v3.1/src/libcf/cf_rebin_probability_array.c + +<BR>v3.1/include/calfuse.h v1.70 + +<P> +We modified cf_combine to support the generation of our new +observation-level spectral files. It now writes the keywords NSPEC, +SPEC###, and WOFF### to the primary HDU of the output file. + +<P> +Three C routines and a shell script generate a new set of +observation-level spectral files. For targets that are bright enough, +we cross-correlate and combine the extracted spectra from each +exposure. For fainter targets, we combine the IDF files from each +exposure and extract a single spectrum for the whole observation. Then +we repeat this exercise for the night-only data. Finally, we combine +observation-level spectra from the various channels into a single +spectral file for submission to the National Virtual Observatory. + +<P> +cf_make_all is the shell script that calls these routines. +<br> +cf_xcorr determines the relative wavelength offset of each exposure. +<br> +cf_pack combines the observation-level spectra from each channel into +a single ALL or ANO (all data, night-only) file. +<br> +cf_nvo selects data from the best channel for each waveband, shifts +it to a common wavelengh scale, and generates the NVO file. + +<P> +In extract_jitter, fixed a bug that set EXPSTART equal to EXPEND. + +<P> +In idf_combine, comment out warning when FPA motion is detected. +The pipeline corrects for this. + +<P> +In cf_calculate_y_centroid, don't override user-specified centroid, +even if it is far from the expected value. Fixed bug in tabulation of +the expected Y centroids. + +<P> +In cf_find_spectra, use airglow centroid of LWRS aperture to constrain +airglow centroids of smaller apertures. Use airglow centroid of +target aperture to constrain search for centroid of target spectrum. + +<P> +In cf_idf_io, allow arrays of floats to be read as doubles. + +<P> +In cf_modify_hist_pha, fixed bug in loop through MJD array. + +<P> +In cf_rebin_probability_array, rounding errors left non-zero +probabilities in regions beyond the ends of the extraction windows. +Re-normalization raised these probabilities to unity. Now, if total +probability in a column is less than 0.1, it is set to zero. + +<P> +<hr WIDTH="100%"> + +<p>April 19, 2005 +<br>Van Dixon + +<BR>v3.0/include/calfuse.h v1.66, v1.67, v1.68, v1.69 + +<P> +Between August and December of 2004, pipeline modifications were +limited to bug fixes and a few new data-analysis routines. Since +January of 2005, we made extensive modifications to the code, both to +correct errors and to add new capabilities. All changes are documented +in the headers of the individual modules and subroutines. Rather than +repeat that information, we list here only the principal changes to the +pipeline's capabilities. + +<P> +In v3.0, data obtained during periods of uncertain pointing information +were often flagged as bad. Now, the jitter files are generated using a +simpler, more robust algorithm to determine when pointing information +is reliable. If it's not, the pipeline does nothing, rather than +flagging the data as bad. + +<P> +In v3.0, data obtained when the detector voltage was less than 95% of +the expected value were flagged as bad. Now, for detectors 1A, 1B, and +2B, the level is 85%. For detector 2A, data with HV > 90% of full is +processed without comment, data with HV > 80% of full generates a +warning message, and data with HV < 80% of full is flagged as bad. +(These limits are stored in the VOLT_CAL file.) For detector 2A data +in the 80-90% range, the user should examine the pulse-hight +distribution of photon events in the target aperture to ensure that the +peak of the distribution is well separated from the background. + +<P> +In v3.0, the geometric-distortion correction moved small segments of the +HIST spectra out of their extraction windows. The solution was to +increase the size of the HIST extraction windows in Y. A new keyword, +HIST_PAD, which depends on both the detector and the aperture, is read +from the header of the corresponding extension of the CHID_CAL file. +While making this change, we found and corrected a bug in the +calculation of the spectral Y centroid that affected both TTAG and +HIST data. + +<P> +In v3.0, the HIST and TTAG wavelength scales did not agree. This was a +result of the walk correction, which was applied to TTAG but not HIST +data. Since the walk correction is never zero, HIST data were never +fully converted to the FARF. We now assign a pulse height (the mean +for a particular date and aperture) to each HIST photon and apply the +walk correction to all data. + +<P> +When scaling the model background image to match the data, the +subroutine cf_scale_bkgd (formerly cf_ttag_bkgd) did not properly +account for regions of the detector excluded because of airglow +contamination. As a result, it underestimated the total background. +The program has been extensively revised. + +<P> +The final extracted spectral (*fcal.fit) files now have the standard +FITS binary table format that was employed in old (v2.4.3 and earlier) +versions of the pipeline. + +<P> +Errors in the calculation of TIME_SUNRISE and TIME_SUNSET have been +corrected. As these values are never greater than 6000 s, they are +now stored (and treated) as SHORTs. + +<P> +If the pipeline cannot compute the centroids of the detector stim +pulses, it now reads a new calibration file (STIM_CAL), in which the +time-dependent average values of the drift coefficients are tabulated. + +<P> +The burst-detection algorithm computes the mean count rate on the +unilluminated regions of the detector and writes it to the IDF. It now +does so for the entire exposure, not just for times previously +identified as good. + +<P> +Several keywords have been added to the IDF file headers, including +the limb-angle limits BRITLIMB and DARKLIMB from the SCRN_CAL file +and the calculated orbital period (ORBPERID). + +<P> +The AIRG_CAL files, which identify regions of each detector likely +to be contaminated by airglow features, are now expressed in FARF, +rather than RAW, coordinates. This change allows us to use smaller +airglow windows and thus to throw away less data. + +<P> +The default pulse-height limits (both upper and lower) have been +modified for all four detectors. + +<P> +<hr WIDTH="100%"> + +<p>August 24, 2004 +<br>Van Dixon +<BR>v3.0/src/libcf/cf_fes_proc_update.c +<BR>v3.0/src/libcf/cf_fes_proc_check.c +<BR>v3.0/src/libcf/cf_count_rate_y_distort.c +<BR>v3.0/src/libcf/cf_calculate_y_centroid.c +<BR>v3.0/src/libcf/cf_optimal_extraction.c + +<BR>v3.0/include/calfuse.h v1.65 + +<P> +Installed two subroutines needed to process FES files. Modified calfuse.h +to support them. + +<P> +In cf_count_rate_y_distort, interpolate stretch correction among +tabulated Y values to prevent counts from piling up at 10-pixel +boundaries. + +<P> +In cf_calculate_y_centroid, confirm that all spectral centroids, not +just that of the target aperture, are within bounds. + +<P> +In cf_optimal_extraction, use QUALITY array to set X limits of +extraction region. Insure that sigma_out array is non-zero. + +<P> +<hr WIDTH="100%"> + +<p>August 12, 2004 +<br>Van Dixon +<BR>v3.0/src/fuv/cf_assign_wavelength.c +<BR>v3.0/src/fuv/cf_bad_pixels.c +<BR>v3.0/src/fuv/cf_extract_spectra.c +<BR>v3.0/src/fuv/cf_remove_motions.c +<BR>v3.0/src/fuv/cf_screen_photons.c +<BR>v3.0/src/libcf/cf_astigmatism_and_dispersion.c +<BR>v3.0/src/libcf/cf_apply_filters.c +<BR>v3.0/src/libcf/cf_calculate_y_centroid.c +<BR>v3.0/src/libcf/cf_fuv_init.c +<BR>v3.0/src/libcf/cf_find_spectra.c +<BR>v3.0/src/libcf/cf_grating_motion.c +<BR>v3.0/src/libcf/cf_identify_channel.c +<BR>v3.0/src/libcf/cf_init_support.c +<BR>v3.0/src/libcf/cf_make_mask.c +<BR>v3.0/src/libcf/cf_mirror_motion.c +<BR>v3.0/src/libcf/cf_modify_hist_times.c +<BR>v3.0/src/libcf/cf_optimal_extraction.c +<BR>v3.0/src/libcf/cf_proc_check.c +<BR>v3.0/src/libcf/cf_rebin_background.c +<BR>v3.0/src/libcf/cf_satellite_jitter.c +<BR>v3.0/src/libcf/cf_screen_burst.c +<BR>v3.0/src/libcf/cf_screen_high_voltage.c +<BR>v3.0/src/libcf/cf_screen_limb_angle.c +<BR>v3.0/src/libcf/cf_set_photon_flags.c +<BR>v3.0/src/libcf/cf_thermal_distort.c +<BR>v3.0/src/libcf/cf_ttag_bkgd.c +<BR>v3.0/src/libcf/cf_write_extracted_spectrum.c +<BR>v3.0/src/libcf/eclipse.c +<BR>v3.0/src/libcf/solar_ang.c +<BR>v3.0/src/libcf/space_vel.c +<BR>v3.0/src/libcf/state_geod.c +<BR>v3.0/src/libcf/state_limb.c + +<BR>v3.0/include/calfuse.h v1.64 + +<P> +Re-organized the pipeline, moving cf_screen_photons before +cf_remove_motions. This required changes to both programs, as well as +a number of subroutines. + +<P> +Numerous modifications to cf_fuv_init: We now allow for the possibility +that the time associated with a calibration file exactly equals +EXPSTART. If the BRIT_OBJ keyword is set to DEFOCUS, we modify +SRC_TYPE to E. Write CF_VERS to trailer file. Set ASTG_COR to +PERFORM, as the pipeline doesn't do it automatically. + +<P> +Changes to routines in cf_init_support: Add BRIT_OBJ keyword to header. +Rewrite fill_hv_array() to make it more robust. If HV values in header +are good, use them to determine whether HV arrays for 2A and 2B are +swapped. + +<P> +In both eclipse and state_geod, we corrected the FORTRAN call to sla_preces. +To address warnings from the Mac OS X compiler, we made minor +modifications to month_day. + +<P> +If more than 90% of an exposure is lost to a burst, jitter, etc., +cf_set_photon_flags will write the cause to the trailer file. + +<P> +Changes to cf_identify_channel: Don't bother shifting extraction +windows to correct for FPA position. If shift is known, it is not needed. +Because the extraction windows don't quite match the WGTS arrays, pad +windows by XPAD pixels in X. Change i (which steps through targ_ap +array) from long to int. + +<P> +Corrected bug in cf_mirror_motion that caused it to swap motion corrections +for sides 1 and 2. (This routine also got a new calibration file.) + +<P> +In cf_grating_motion, we estimate the time between sunrises using the +orbit period in the file header, rather than assuming a 6000-second orbit. + +<P> +In cf_satellite_jitter, we skip the jitter correction if the jitter +file lacks the JIT_STAT keyword. The program returns EXP_JITR +to the calling routine. + +<P> +Both cf_find_spectra and cf_calculate_y_centroid now use the photon +flags to exclude events arriving during bursts, etc., from their +centroid calculations. + +<P> +In cf_astigmatism_and_dispersion, must change ASTG_COR to COMPLETE or +SKIPPED by hand, as the pipeline won't do it automatically. + +<P> +Changes to bad-pixel routines: Fixed bug in cf_make_mask, changing & to &&. + +<P> +Changes to extraction subroutines: +Fixed bug in cf_ttag_bkgd: nxb was undefined if RUN_BKGD = NO. +Don't bother shifting the weights array to account for FPA motions, as +this should already have been corrected in the conversion to the FARF. +In cf_optimal_extraction: If weights_out[j] = 0, set variance = bkgd. +Iterate optimal extraction to accuracy of 0.01 counts. In the boxcar +extraction algorithm, we reduced the parray limit to 1E-4 to better +match fluxes from optimal extraction for bright stars. +The routine cf_write_extracted_spectrum now has an option (-o) +to override the default root name for the extracted spectra. + +<P> +Removed unused variables from the following routines: state_limb, +cf_rebin_background, cf_screen_high_voltage, cf_screen_limb_angle, +cf_thermal_distort, solar_ang, space_vel, and cf_bad_pixels. + +<P> +Made minor i/o changes to cf_screen_burst. The routine cf_proc_check +now calls cf_verbose rather than cf_if_warning when a pipeline step is +inappropriate for TTAG data. + +<P> +We made a lot of changes to the way that we deal with time for HIST +data: In cf_apply_filters, we mask the BRST, SAA, and LIMB flags when +calculating exposure time. In cf_set_photon_flags, we set only DAY +flag; we all write other flags to EXP_STAT keyword. A new routine, +cf_modify_hist_times, sets the photon-arrival times of photons in HIST +files to the midpoint of the longest good-time interval. + +<P> +This is the release version 3.0.7 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>June 4, 2004 +<br>Van Dixon +<BR>v2.4/src/fuv/cf_fuv_init.c +<BR>v2.4/include/calfuse.h v1.175 + +<P> +Modified cf_fuv_init to allow for the possibility that the MJD for a +calibration file equals EXPSTART for an exposure. + +<P> +This is version 2.4.4 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>May 13, 2004 +<br>Van Dixon +<BR>v2.4/src/fuv/cf_update_qual.c +<BR>v2.4/src/fuv/cf_dtcor.c +<BR>v2.4/include/calfuse.h v1.174 + +<P> +Modified cf_update_qual and cf_dtcor to deal gracefully with bad +counters in the data file headers. + +<P> +This is version 2.4.3 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>May 4, 2004 +<br>Van Dixon +<BR>v3.0/src/fuv/cf_assign_wavelength.c +<BR>v3.0/src/fuv/cf_countmap.c +<BR>v3.0/src/fuv/cf_extract_spectra.c +<BR>v3.0/src/fuv/cf_gainmap.c +<BR>v3.0/src/fuv/cf_hist_init.c +<BR>v3.0/src/fuv/cf_remove_motions.c +<BR>v3.0/src/fuv/cf_ttag_init.c +<BR>v3.0/src/libcf/cf_apply_dead_time.c +<BR>v3.0/src/libcf/cf_calculate_y_centroid.c +<BR>v3.0/src/libcf/cf_convert_to_ergs.c +<BR>v3.0/src/libcf/cf_doppler_and_heliocentric.c.c +<BR>v3.0/src/libcf/cf_error_msg.c +<BR>v3.0/src/libcf/cf_find_spectra.c +<BR>v3.0/src/libcf/cf_fuv_init.c +<BR>v3.0/src/libcf/cf_init_support.c +<BR>v3.0/src/libcf/cf_rebin_background.c +<BR>v3.0/src/libcf/cf_set_good_time_intervals.c +<BR>v3.0/src/libcf/cf_set_photon_flags.c +<BR>v3.0/src/libcf/cf_set_user_gtis.c +<BR>v3.0/src/libcf/cf_source_aper.c +<BR>v3.0/src/libcf/cf_ttag_bkgd.c +<BR>v3.0/src/libcf/cf_write_extracted_spectrum.c + +<BR>v3.0/include/calfuse.h v1.61, v1.62, v1.63 + +<P> +Bernard performed housecleaning (removing unused variables, changing +variable types to match subroutine definitions, etc.) on the following +routines: cf_assign_wavelength, cf_hist_init, cf_ttag_init, cf_countmap, +and cf_bad_pixels.c. Also these subroutines: cf_apply_dead_time, +cf_calculate_y_centroid, cf_doppler_and_heliocentric.c, +cf_error_msg, cf_init_support, cf_set_good_time_intervals, +cf_set_photon_flags, cf_set_user_gtis, and cf_source_aper. + +In addition, he modified cf_ttag_init to create a photon list +containing a single dummy event when the raw file is empty and +cf_init_support to better catch errors in the header counter keywords. + +<P> +We made significant modifications to cf_extract_spectra, replacing +cf_rebin_and_flux_calibrate_background with cf_rebin_background. +cf_optimal_extraction now performs all calculations with the weights +array, rather than ergcm2. It returns counts and sigma arrays, rather +than flux and variance as before; cf_extract_spectra must +flux-calibrate each array, and cf_write_extracted_spectrum no longer +converts from variance to sigma. The boxcar algorithm now uses the +probability (weights) array to set the limits of the extraction window, +better replicating the results of optimal extraction. Optimal +extraction now iterates to 10% accuracy. The output weights and bkgd +arrays are calculated by the optimal-extraction routine, so better +match the final flux-calibrated spectra. + +<P> +In verbose mode, cf_convert_to_ergs prints out the relative weighting of +the two effective-area files. + +<P> +The first call to cf_identify_channel was moved from cf_find_spectra to +cf_remove_motions. The documentation of cf_remove_motions was improved. + +<P> +The keywords MKBK_COR and BKGD_COR are gone, so cf_fuv_init no longer +populates them. + +<P> +The routine cf_rebin_and_flux_calibrate_background was replaced by +cf_rebin_background. Flux calibration is now performed by +cf_extract_spectra. cf_ttag_bkgd returns a null-valued background +image if RUN_BKGD = NO. + +<P> +This is version 3.0.7 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>April 5, 2004 +<br>Van Dixon +<BR>v3.0/src/libcf/cf_geometric_distort.c +<BR>v3.0/include/calfuse.h v1.60 + +<P> +Rescale SPECBINY only if it is > 1. + +<P> +<hr WIDTH="100%"> + +<p>April 1,2004 +<br>Van Dixon +<BR>v3.0/src/fuv/cf_extract_spectra.c +<BR>v3.0/src/libcf/cf_geometric_distort.c +<BR>v3.0/src/libcf/cf_hist_init.c +<BR>v3.0/src/libcf/cf_init_support.c +<BR>v3.0/src/libcf/cf_optimal_extraction.c +<BR>v3.0/src/libcf/cf_proc_check.c +<BR>v3.0/src/libcf/cf_rebin_probability_array.c +<BR>v3.0/src/libcf/cf_ttag_bkgd.c +<BR>v3.0/src/libcf/cf_write_extracted_spectrum.c +<BR>v3.0/include/calfuse.h v1.59 + +<P> +Abandon use of WPC array throughout the pipeline. Instead, modify +cf_optimal_extraction to evenly distribute photon events across +one X pixel when in HIST mode. If optimal-extraction loop does not +converge within 50 iterations, exit and use results from boxcar extraction. +<p> +In cf_proc_check, call cf_verbose rather than cf_if_warning if program +not appropriate for HIST data. +<p> +Change the way that routines deal with empty data files. In +cf_hist_init, issue a warning -- but continue +processing -- if NEVENTS = 0. (A similar change for cf_ttag_init +will have to wait for the next version of the pipeline.) +In cf_extract_spectra, write null-valued +output spectra if either EXPTIME or NEVENTS = 0. In +cf_write_extracted_spectrum, if valid_spectrum = FALSE, write warning +message to file header. +<p> +Include math.h in cf_hist_init to define fmod(). This solves the +long-standing problem of the program crashing on Linux machines. +<p> +Modify cf_init_support to better deal with counter errors. +<p> +In cf_geometric_distort, modify header keyword SPECBINY to reflect +Y spacing in the FARF. +<p> +In cf_ttag_bkgd, set Y limits of 2-D background arrays equal to those +of the probability (weights) array. Since the sizes are now equal, +cf_optimal_extraction does not need to test them. Make centroid of +probability array a float in cf_extract_spectra and associated +subroutines. +<p> +In cf_rebin_probability_array, shift probability array to account +for position of FPA. + +<P> +This is version 3.0.6 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>March 30, 2004 +<br>Van Dixon +<BR>v2.4/src/fuv/cf_hist_init.c +<BR>v2.4/include/calfuse.h v1.173 + +<P> +Modified cf_hist_init to produce +null-valued data file if NEVENTS=0. + +<P> +This is version 2.4.2 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>March 16,2004 +<br>Van Dixon +<BR>v3.0/src/fuv/cf_extract_spectra.c +<BR>v3.0/src/fuv/cf_hist_init.c +<BR>v3.0/src/fuv/cf_ttag_init.c +<BR>v3.0/src/fuv/cf_bad_pixels.c +<BR>v3.0/src/fuv/cf_countmap.c +<BR>v3.0/src/fuv/cf_gainmap.c +<BR>v3.0/src/fuv/cf_convert_to_farf.c +<BR>v3.0/src/libcf/cf_astigmatism_and_dispersion.c +<BR>v3.0/src/libcf/cf_init_support.c +<BR>v3.0/src/libcf/cf_satellite_jitter.c +<BR>v3.0/src/libcf/cf_thermal_distort.c +<BR>v3.0/src/libcf/cf_write_extracted_spectrum.c +<BR>v3.0/include/calfuse.h v1.57, v1.58 + +<P> +Implement WPC array in cf_extract_spectra and associated subroutines. +<br>In cf_hist_init.c, fix error in correcting hot pixels. +<br>In cf_ttag_init.c, exit if no photons in raw data file. +<br>In cf_bad_pixels.c, change maximum size of the output arrays in +cf_combine_pothole_data and insure that lif_cnt and sic_cnt arrays are +non zero. +<br>In cf_countmap.c and cf_gainmap.c, allow user to select coordinate +system: RAW, FARF (default), final. +<br>In cf_astigmatism_and_dispersion.c, make subroutine cf_x2lambda globally +accessible. +<br>In cf_convert_to_farf.c, pass weight array to cf_thermal_distort. +<br>In cf_init_support.c, read begin and end counters as float. +Set countrate to zero when cntb is more than 16777216. +<br>In cf_satellite_jitter.c, polulate the PLATESC keyword in the input file header. +<br>In cf_thermal_distort.c, added weights to the calculation (needed for +histogram mode) and corrected bug in procedure for finding stim pulses. +<br>In cf_write_extracted_spectrum.c, populate archive search keywords and +change name of POTHOLE column to QUALITY. + +<P> +This is version 3.0.5 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>February 16, 2004 +<br>Van Dixon +<BR>v3.0/include/calfuse.h v1.56 + +<P> +Release CalFUSE v3.0.4 for beta testing. + +<P> +<hr WIDTH="100%"> + +<p>May 22, 2003 +<br>Van Dixon +<BR>v2.4/src/idl/cf_plot_rate.pro +<BR>v2.4/src/fuv/fcal.c +<BR>v2.4/src/fuv/cf_make_ttag_bkgd.c +<BR>v2.4/include/calfuse.h v1.172 + +<P> +Modified cf_plot_rate.pro, fcal.c, and cf_make_ttag_bkgd.c to deal +gracefully with zero-length exposures. Resulting spectral file has +FLUX and ERROR arrays set to zero. + +<P> +This is version 2.4.1 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>May 19, 2003 +<br>Van Dixon +<BR>v2.4/src/analysis/cf_combine.c +<BR>v2.4/include/calfuse.h v1.171 + +<P> +Imported two of Jeff's modifications to cf_combine: +<br> +Close each input file in initial loop. +Without this, cfitsio crashes upon opening the 60th file. +<br> +Weight each pixel by exposure time after excluding ``bad'' pixels. + +<P> +<hr WIDTH="100%"> + +<p>May 2, 2003 +<br>Van Dixon +<BR>v2.4/src/analysis/cf_uninterp.c +<BR>v2.4/include/calfuse.h v1.170 + +<P> +Added cf_uninterp.c to re-calibrate extracted spectra using only +the most recent flux-calibration file. + +<P> +This is version 2.4.0 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>April 29, 2003 +<br>Van Dixon +<BR>v2.3/src/fuv/cf_ttag_jitter.c +<BR>v2.3/src/fuv/cf_hist_jitter.c +<BR>v2.3/include/calfuse.h v1.169 + +<P> +Modified jitter routines to allow possiblity that jitter filename is in +lower-case letters. + +<P> +<hr WIDTH="100%"> + +<p>April 25, 2003 +<br>Van Dixon +<BR>v2.3/src/fuv/cf_fuv_init.c +<BR>v2.3/include/calfuse.h v1.167, v1.168 + +<P> +In cf_fuv_init, never linearly extrapolate calibration files forward in +time. If an observation is not bracketed by calibration files, +simply use the latest one. + +<P> +This is version 2.3.2 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>April 16, 2003 +<br>Van Dixon +<BR>v2.3/src/fuv/cf_fuv_init.c +<BR>v2.3/include/calfuse.h v1.166 + +<P> +In cf_fuv_init, test for corrupted detector bias values. Updated +comment field of HV_FLAG. Modified associated warning messages. + +<P> +This is version 2.3.1 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>April 15, 2003 +<br>Van Dixon +<BR>v2.3/src/fuv/cf_ttag_screen.c +<BR>v2.3/include/calfuse.h v1.165, v1.166 + +<P> +Test only first letter of scrn*.fit keyword DAYNIGHT in cf_ttag_screen. + +<P> +<hr WIDTH="100%"> + +<p>April 2, 2003 +<br>Van Dixon +<BR>v2.3/src/fuv/cf_ttag_geodopp.c +<BR>v2.3/src/fuv/cf_ttag_jitter.c +<BR>v2.3/include/calfuse.h v1.164 + +<P> +Simplified DX/DY test in cf_ttag_geodopp. Test that TRKFLG is <= 5 +(the highest allowed value) in cf_ttag_jitter. + +<P> +<hr WIDTH="100%"> + +<p>April 2, 2003 +<br>Van Dixon +<BR>v2.3/src/fuv/cf_ttag_geodopp.c +<BR>v2.3/include/calfuse.h v1.163 + +<P> +Test DX and DY values to make sure they are valid before combining +into mean Doppler shift. NaN values lead to bad-pixels masks full +of zeros, which lead to empty extracted spectra. + +<P> +<hr WIDTH="100%"> + +<p>March 10, 2003 +<br>Van Dixon +<BR>v2.3/src/fuv/cf_ttag_geodopp.c +<BR>v2.3/include/calfuse.h v1.162 + +<P> +Alain Lecavelier points out that, for high-count-rate TTAG data, the +pipeline produces error bars that are about half of what one would +expect from SQRT(N) statistics. Turns out that the change that I made +to cf_ttag_geodopp in March 2002 was in error. I returned the code to +its previous state, and the error bars are now much better behaved. +Error bars for histogram data are unaffected by this change. + +<P> +This is version 2.3.0 of the CalFUSE pipeline. + +<P> +<hr WIDTH="100%"> + +<p>February 24, 2003 +<br>Van Dixon +<BR>v2.2/src/fuv/cf_make_ttag_bkgd.c +<BR>v2.2/src/fuv/cf_make_hist_bkgd.c +<BR>v2.2/include/calfuse.h v1.161 + +<P> +Peter Young's Dec Alpha compiler identified a bug in these routines. +EXPNIGHT is stored in the header as type LONG, but these routines read +it as type FLOAT. CFITSIO should make the conversion automatically, +but apparently fails to do so on his machine. I've modified the calls +to FITS_read_key() in both routines. +<P> +<font color=red>This is the release version of CalFUSE v2.2.3.</font> + +<P> +<hr WIDTH="100%"> + +<p>February 20, 2003 +<br>Van Dixon +<BR>v2.2/src/libcf/read_tle.c +<BR>v2.2/src/libcf/sgp4.c +<BR>v2.2/src/fuv/cf_ttag_jitter.c +<BR>v2.2/src/fuv/cf_make_ttag_bkgd.c +<BR>v2.2/src/fuv/cf_extract.c +<BR>v2.2/src/fuv/cf_driftcorr2.c +<BR>v2.2/src/fuv/cf_coadd.c +<BR>v2.2/src/analysis/ttag_combine.c +<BR>v2.2/include/calfuse.h v1.160 + +<P> +Peter Young's Dec Alpha compiler identified two sets of bugs in these routines. +Several calls to FITS_read_key() or FITS_update_key() used an ampersand incorrectly: +<br> +FITS_read_key(fptr, TSTRING, "INSTRUME", &instrument, comment, &status); +<br> +and a few routines used abs() when fabs() is required. +<P> +P.Y.'s compiler refused to recognize one of the #define keywords in +sgp4.c, so Bryce Roberts replaced it with the actual value throughout +the routine. + +<P> +<hr WIDTH="100%"> + +<p>December 13, 2002 +<br>Van Dixon +<BR>v2.2/src/fuv/cf_ttag_screen.c +<BR>v2.2/src/fuv/cf_hist_screen.c +<BR>v2.2/src/fuv/cf_ttag_burst.c +<BR>v2.2/src/fuv/cf_ttag_jitter.c +<BR>v2.2/include/calfuse.h v1.159 + +<P> +Modify cf_ttag_screen and cf_hist_screen to write all EXP_* keywords as +type long. Modify cf_ttag_burst and cf_ttag_jitter to pass through all +photon events in the stim-pin regions, even during bad times. Have +them add EXP_BRST and EXP_JITR to EXP_BAD, and write all as type long. + +<P> +Updated CALFUSE version to 2.2.3. + +<P> +<hr WIDTH="100%"> + +<p>November 8, 2002 +<br>Van Dixon +<BR>v2.2/src/fuv/cf_extract.c +<BR>v2.2/include/calfuse.h v1.158 + +<P> +Modify cf_extract to write keyword SPECYCNT to outfits, not infits. + +<P> +<hr WIDTH="100%"> + +<p>November 6, 2002 +<br>Van Dixon +<BR>v2.2/src/fuv/cf_hist_jitter.c +<BR>v2.2/src/fuv/cf_ttag_jitter.c +<BR>v2.2/include/calfuse.h v1.157 + +<P> +Make cf_hist_jitter and cf_ttag_jitter issue warning, but continue +running, if keyword JIT_STAT is not found. + +<P> +<hr WIDTH="100%"> + +<p>November 1, 2002 +<br>Van Dixon +<BR>v2.2/src/fuv/cf_hist_jitter.c +<BR>v2.2/idl/cf_plot_hist_rate.pro +<BR>v2.2/include/calfuse.h v1.156 + +<P> +Make cf_hist_jitter and cf_plot_hist_rate exit gracefully if jitter +file not found. + +<P> +<hr WIDTH="100%"> + +<p>October 29, 2002 +<br>Van Dixon +<BR>v2.2/src/analysis/cf_arith.c +<BR>v2.2/src/analysis/cf_combine.c +<BR>v2.2/include/calfuse.h v1.155 + +<P> +Corrected error in history lines of both routines. + +<P> +<hr WIDTH="100%"> + +<p>October 24, 2002 +<br>Van Dixon +<BR>v2.2/src/fuv/Makefile +<BR>v2.2/src/fuv/cf_make_hist_bkgd.c +<BR>v2.2/include/calfuse.h v1.154 + +<P> +Add cf_hist_jitter to Makefiles. +Remove unused variables in cf_make_ttag_bkgd. + +<P> +<hr WIDTH="100%"> + +<p>October 11, 2002 +<br>Van Dixon +<BR>v2.2/src/fuv/cf_ttag_jitter.c +<BR>v2.2/include/calfuse.h v1.153 + +<P> +Three changes to cf_ttag_jitter: Initialized nrej to 0, made program +exit quietly if jitter file not found, and set all times to floats in +test step, to correct bug whereby some photons were being erroneously +rejected. Note that the program still rejects photons with times later +than the end of the input good-time interval. This happens because the +burst-correction routine converts the GTI boundaries to integers. + +<P> +Updated CALFUSE version to 2.2.2. + +<P> +<hr WIDTH="100%"> + +<p>August 29, 2002 +<br>Van Dixon +<BR>v2.2/src/fuv/cf_hist_init.c +<BR>v2.2/src/fuv/cf_ttag_init.c +<BR>v2.2/include/calfuse.h v1.152 + +<P> +The initialization routines now exit with an error if NEVENTS = 0. + +<P> +<hr WIDTH="100%"> + +<p>August 28, 2002 +<br>Van Dixon +<BR>v2.2/src/fuv/cf_hist_jitter.c +<BR>v2.2/src/libcf/cf_fcal.c +<BR>v2.2/idl/cf_plot_hist_rate.pro +<BR>v2.2/include/calfuse.h v1.151 + +<P> +cf_hist_jitter reads the jitter file, determines how much time (if any) +the target spent out of the aperture, and writes this number to the +keyword EXP_JITR. cf_fcal subtracts this value from EXPTIME when +flux-calibrating the spectrum. The IDL procedure cf_plot_hist_rate.pro +plots the count rate during a histogram exposure using counter values +from the housekeeping file. + +<P> +Updated CALFUSE version to 2.2.1. + +<P> +<hr WIDTH="100%"> + +<p>July 31, 2002 +<br>Van Dixon +<BR>v2.2/src/fuv/cf_hist_count_map.c +<BR>v2.2/src/fuv/cf_ttag_count_map.c +<BR>v2.2/src/fuv/cf_ttag_gain_map.c +<BR>v2.2/src/fuv/cf_make_ttag_bkgd.c +<BR>v2.2/src/fuv/cf_ttag_jitter.c +<BR>v2.2/src/fuv/cf_update_qual.c +<BR>v2.2/src/libcf/cf_fuv_init.c +<BR>v2.2/include/calfuse.h v1.150 + +<P> +The SDP group decided that CalFUSE 3.0 should use a radically different +scheme for processing time-tagged data. In the mean time, we have made +incremental progress on CalFUSE v2, and we have decided that this +version of the program should go behind the firewall as soon as +possible. Accordingly, I copied v2.1.7 to v2.2.0 and have continuued +to make incremental changes to the code. Highlights are + +<P> +Modify cf_hist_count_map, cf_ttag_count_map, cf_ttag_gain_map, and +cf_update_qual to read version 002 YSTR files. +<BR> +Correct a Linux bug in cf_make_ttag_bkgd. +<BR> +Add cf_ttag_jitter and modify cf_fuv_init to support it. + +<P> +Updated CALFUSE version to 2.2.0. +<P> +<font color=red>This version of CalFUSE will go behind the firewall on +1 August 2002.</font> + +<P> +<hr WIDTH="100%"> + +<p>June 14, 2002 +<br>Van Dixon +<BR>v2.1/src/fuv/cf_make_ttag_bkgd.c +<BR>v2.1/include/calfuse.h v1.149 + +<p> +Moved v1.16 of cf_make_ttag_bkgd back to CalFUSE v2.1. +<P> +Updated CALFUSE version to 2.1.7. + +<hr WIDTH="100%"> + +<p>June 14, 2002 +<br>Van Dixon +<BR>cf_make_ttag_bkgd.c +<BR>cf_undistort.c +<BR>cf_driftcorr.c +<BR>cf_extract.c +<BR>cf_dpix.c +<BR>cf_ttag_screen.c +<BR>cf_hist_dopp.c +<BR>cf_wcal.c +<BR>cf_doppler_util.c +<BR>calfuse.h v1.151 + +<br> +<p> +In cf_make_ttag_bkgd, correct error when using MKBK_COR=OMIT (1.15) and +fill in holes made by the removal of geocoronal lines. The latter is +needed in determination of X variations of scattered light. Re-wrote +cf_undistort to handle shifts as floats. Modified cf_driftcorr to +write output as an array of shorts. Modified cf_extract, cf_dpix to +read linear wavelength scale. Modified read_wavelengths in +cf_doppler_util and calls to it in cf_ttag_screen and cf_hist_dopp. +Modified cf_wcal to implement linear wavelength solution. +<P> +Updated CALFUSE version to 3.0.1. + +<hr WIDTH="100%"> + +<p>May 30, 2002 +<br>Van Dixon +<BR>cf_doppler_util.c +<BR>cf_ttag_screen.c +<BR>cf_hist_dopp.c +<BR>cf_dpix.c +<BR>cf_extract.c +<BR>calfuse.h v1.150 + +<br> +<p> +In cf_doppler_util, modified read_wavelength no longer to generate and +return an xpix array, then modified the calling routines cf_ttag_screen +and cf_hist_dopp accordingly. Modified cf_dpix and cf_extract to +handle the linear wavelength scale. + +<hr WIDTH="100%"> + +<p>May 29, 2002 +<br>Van Dixon +<BR>cf_doppler_util.c +<BR>cf_driftcorr.c +<BR>cf_update_qual.c +<BR>calfuse.h v1.149 + +<br> +<p> +In cf_doppler_util, modified the subroutine read_wavelength to handle a +linear wavelength scale. Installed Rich's new version of cf_driftcorr, +which puts a correction for the count-rate dependent Y stretch into the +DY image. Because we no longer need to correct the bad-pixel map for +the Y stretch, I moved back from v1.8 to v1.5 of cf_update_qual. + +<hr WIDTH="100%"> + +<p>May 21, 2002 +<br>Van Dixon +<BR>cf_dpix +<BR>calfuse.h v1.148 + +<br> +<p> +Fixed a couple of bugs in cf_dpix: made LWRS the default aperture and +allowed the boundary between the SiC and LiF regions to vary with +detector. +<p> +Made this change to both v2.1 and v3.0. + +<hr WIDTH="100%"> + +<p>May 17, 2002 +<br>Van Dixon +<BR>cf_dtcorr +<BR>cf_undistort +<BR>cf_wcal +<BR>calfuse.h v1.147 + +<br> +<p> +Updated #define keywords in cf_dtcorr. Turned on X-distortion +correction in cf_undistort and moved it to follow cf_driftcorr2. +Implemented linear wavelength scale in cf_wcal. +<p> +Updated CALFUSE version to 3.0.0. + +<hr WIDTH="100%"> + +<p>May 14, 2002 +<br>Van Dixon +<BR>cf_make_ttag_bkgd +<BR>cf_make_hist_bkgd +<BR>calfuse.h v1.146 + +<br> +<p> +Teach background modules to read compressed background-calibration files. +<P> +<font color=red>This is the release version of CalFUSE v2.1.</font> + +<hr WIDTH="100%"> + +<p>April 16, 2002 +<br>Van Dixon +<BR>cal_fuse_exp_ttag.csh +<BR>cal_fuse_exp_hist.csh +<BR>calfuse.h v1.145 + +<br> +<p> +Remove cf_wormcorr from pipeline for now. +<P> +Updated CALFUSE version to 2.1.6. + +<hr WIDTH="100%"> + +<p>April 8, 2002 +<br>Van Dixon +<BR>cf_make_hist_bkgd +<BR>cf_make_ttag_bkgd +<BR>cf_ttag_burst +<BR>bchr*001.fit +<BR>scrn*013.fit +<BR>calfuse.h v1.144 + +<br> +<p> +New software from Rich: New BCHR (background characterization) files +contain the binary extensions that used to be in the SCRN files. +Pipeline modules were modified to read the new files. +<P> +Updated CALFUSE version to 2.1.5. + +<hr WIDTH="100%"> + +<p>March 29, 2002 +<br>Van Dixon +<BR>cf_make_ttag_bkgd +<BR>cf_ttag_burst +<BR>bkgd*005.fit +<BR>bkgd*006.fit +<BR>bkgd*007.fit +<BR>bkgd*008.fit +<BR>scrn*012.fit +<BR>calfuse.h v1.143 + +<br> +<p> +New software from Rich: The burst module has been modified to update +the EXPNIGHT value. The background module has a new procedure for +determining the intrinsic background from the data. The background +files should do a better job at short wavelengths. The screening files +redefine the background sample regions and add a few more geocoronal +line positions. +<P> +Updated CALFUSE version to 2.1.4. + +<hr WIDTH="100%"> + +<p>March 17, 2002 +<br>Van Dixon +<BR>cf_make_ttag_bkgd +<BR>cf_make_hist_bkgd +<BR>cf_ttag_geodopp +<BR>cf_hist_geodopp +<BR>calfuse.h v1.142 + +<br> +<p> +Turns out that all of these programs were treating the error arrays as +sigmas rather than variances (sigma squared). Modified to propagate +errors correctly. + +<P> +Updated CALFUSE version to 2.1.3. + +<hr WIDTH="100%"> + +<p>February 22, 2002 +<br>Van Dixon +<BR>cf_fuv_init +<BR>ttag_combine +<BR>cf_dtcor +<BR>calfuse.h v1.141 + +<br> +<p> +Introduced new keyword, RAWTIME, which is equal to EXPTIME before +CalFUSE starts tossing out data. Modified cf_fuv_init and ttag_combine +to propagate it correctly. +<p> +Modified cf_dtcor to determine exposure time from the keywords CTIME_B +and CTIME_E, which are the times of the initial and final engineering +packets from which the counter data were taken. +<P> +Updated CALFUSE version to 2.1.2. + +<hr WIDTH="100%"> + +<p>February 15, 2002 +<br>Van Dixon +<BR>calfuse.h v1.140 + +<br> +<p> +Changed OPUS_VERSION to 2.5. + +<hr WIDTH="100%"> + +<p>February 13, 2002 +<br>Van Dixon +<BR>cf_fuv_init +<BR>ttag_combine +<BR>calfuse.h v1.139 + +<br> +<p> +Modified logic of voltage test in cf_fuv_init. Add COMMENT lines +to data file header if low voltage found. Respond gracefully if +bias keywords do not exist. +<p> +Modified ttag_combine to respond gracefully if EXPNIGHT does not exist. + +<hr WIDTH="100%"> + +<p>February 12, 2002 +<br>Van Dixon +<BR>cf_fuv_init +<BR>calfuse.h v1.138 + +<br> +<p> +Modified cf_fuv_init to check detector voltage and complain if low. +New volt***001.fit calibration files, VOLT_CAL keyword. +<P> +Updated CALFUSE version to 2.1.1. + +<hr WIDTH="100%"> + +<p>January 25, 2002 +<br>Van Dixon +<BR>cf_ttag_burst +<BR>calfuse.h v1.137 + +<br> +<p> +Modified cf_ttag_burst to write a list of bursts to an ASCII file. + +<hr WIDTH="100%"> + +<p>January 15, 2002 +<br>Van Dixon +<BR>ttag_combine +<BR>calfuse.h v1.136 + +<br> +<p> +Modified ttag_combine to update keyword EXPNIGHT in output file. + +<hr WIDTH="100%"> + +<p>December 7, 2001 +<br>Van Dixon +<BR>cf_update_qual +<BR>calfuse.h v1.135 + +<br> +<p> +Richard's new version of cf_update_qual modifies the bad-pixel maps to +account for the count-rate dependence of the detector Y scale. + +<hr WIDTH="100%"> + +<p>November 30, 2001 +<br>Van Dixon +<BR>cf_dpix, cf_extract, cf_wormcorr, cf_optextract, cf_spexextract, +cf_plot_extract.pro, cal_fuse_exp_ttag.csh, cal_fuse_exp_hist.csh, +parm**007.fit +<BR>calfuse.h v1.134 + +<br> +<p> +In earlier versions of the pipeline, the shift to correct for FPA +offsets was performed by cf_wcal. We have moved it earlier in the +pipeline, right after the astigmatism correction, and combine the +FPA corrections with the other shifts in order to have a single +float-to-integer conversion. The new module is called cf_dpix. + +<p> +cf_extract now reads the keyword RUN_OPTI, rather than OPT_EXTR, from +the parameter file. It also writes the Y centroid of each spectrum to +the corresponding output file header. + +<p> +Sylvestre added software to identify the worm in the LiF 1B spectrum: +cf_wormcorr reads the keyword RUN_WORM from the parameter file. If +RUN_WORM = LIF, SIC, or BOTH, the program attempts to identify the +region of the worm and write the range of affected pixels (WORM_BEG and +WORM_END) to the output file header. The IDL routine +cf_plot_extract.pro draws a ring around the worm, if found. + +<p> Modified cal_fuse_exp_ttag.csh and cal_fuse_exp_hist.csh to call +both cf_dpix and cf_wormcorr. Modified calfuse.h to include new +processing keywords DPIX_COR and WORM_COR. + +<hr WIDTH="100%"> + +<p>November 27, 2001 +<br>Van Dixon +<BR>cf_ttag_screen +<BR>calfuse.h v1.133 + +<br> +<p> +Changed the way that cf_ttag_screen treats user-defined good-time +intervals. Now takes intersection of them with pre-defined intervals +(from OPUS or cf_ttag_combine) before screening. Also changed the +module to apply all screens (SAA, day/night, limb angle, pulse height) +regardless of where the good-time intervals came from. Screening can +be turned off by modifying the <tt>scrn*.fit</tt> files, if desired. + +<hr WIDTH="100%"> + +<p>November 21, 2001 +<br>Van Dixon +<BR>cf_update_qual +<BR>calfuse.h v1.132 + +<br> +<p> +Installed Rich's new QUAL files. Modified cf_update_qual to read them. + +<hr WIDTH="100%"> + +<p>November 16, 2001 +<br>Van Dixon +<BR>calfuse.h v1.131 + +<br> +<p> +Defined NO_PIXEL in calfuse.h. Used by geometric-distortion and +extraction routines. + +<hr WIDTH="100%"> + +<p>October 26, 2001 +<br>Van Dixon +<BR>cf_dtcor +<BR>calfuse.h v1.130 + +<br> +<p> +Modified cf_dtcor to set counters to zero if values are too large to +read as longs. + +<hr WIDTH="100%"> + +<p>October 26, 2001 +<br>Van Dixon +<BR>cf_fuv_init +<BR>calfuse.h v1.129 + +<br> +<p> +Modified cf_fuv_init to check header keyword OPUSVERS and complain if +the data file was processed using an old version of OPUS. + +<hr WIDTH="100%"> + +<p>October 10, 2001 +<br>Van Dixon +<BR>cf_ttag_init +<BR>calfuse.h v1.128 + +<br> +<p> +Modified cf_ttag_init to reset the keywords SPECBINX, SPECBINY, +SIA_TBL, and NUM_HIST without checking their current value. +This code was moved from cf_ttag_image, where it had been +commented out in April 2001. +<p> +Added keyword OPUS_VERSION to calfuse.h +<p> +Updated CALFUSE version to 2.1.0. + +<hr WIDTH="100%"> + +<p>October 10, 2001 +<br>Van Dixon +<BR>ttag_combine +<BR>flux*008.fit +<BR>calfuse.h v1.127 + +<br> +<p> +Rich Robinson has made numerous upgrades to ttag_combine. Among other +things, it can now handle the DX, DY and DNFLG columns added by +cf_ttag_init. +<p> +Jeff Kruk has produced new flux-calibration files +based on the latest wavelength calibration. +<p> +Updated CALFUSE version to 2.0.5. +<font color=red>This is the release version of CalFUSE v2.0.</font> + +<hr WIDTH="100%"> + +<p>October 2, 2001 +<br>Van Dixon +<BR>wave*014.fit + +<br> +<p> +Don Lindler has produced new wavelength files appropriate for data that +do NOT have the walk correction applied to their stim pins. +They were created by taking the previous line locations and correcting +them before fitting by: + +<pre> + xx = ((x-leftF)/(rightF-leftF))*(right1-left1)+left1 + xcor = ((xx-left2)/(right2-left2))*(rightF-leftF)+leftF +where: + left1,right1 are the measured STIM positions when the walk correction + was applied to the STIMs + left2,right2 are the measured STIM positions when the walk correction + was not applied to the STIMs + leftF, rightF - are the FARF STIM positions + x - is the measured x position in the spectra that had the walk + correction applied to the STIMs + xcor is the corrected x position that would be expected if the walk + correction was not applied to the STIMs +</pre> + +<hr WIDTH="100%"> + +<p>September 21, 2001 +<br>Van Dixon +<BR>scrn*010.fit + +<br> +<p> +Version 008 had new PHA limits. Version 009 had new information for +background models. Version 010 has both. + +<hr WIDTH="100%"> + +<p>September 17, 2001 +<br>Van Dixon +<br>calfuse.h 1.126 +<BR>cf_make_ttag_bkgd + +<br> +<p> +New version of background routine reads the keyword BKGDTYPE in the +screening file. Default value is 1; if set to -1, routine does not +perform an iterative fit to the observed scattered light. +<P> +Installed new wavelength calibration files, v013, which are corrected +for the motion of the stim pins due to walk correction in previous +versions of the pipeline. +<P> +Updated CALFUSE version to 2.0.4. + +<hr WIDTH="100%"> + +<p>September 11, 2001 +<br>Van Dixon +<br>calfuse.h 1.125 +<BR>cf_ttag_walk +<BR>cf_hist_walk + +<br> +<p> +Don't apply walk correction to photons/pixels within STIM_PAD (512) +pixels of the detector edge. New walk-correction files (v003) have +zeros in the stim-pin region. + +<hr WIDTH="100%"> + +<p>September 5, 2001 +<br>Van Dixon +<br>calfuse.h 1.124 +<BR>cf_make_ttag_bkgd +<BR>cf_extract + +<br> +<p> +If MKBK_COR is set to OMIT, cf_make_ttag_bkgd changes it to SKIPPED. +cf_extract copies the keyword OPT_EXTR into the FITS file headers. + +<hr WIDTH="100%"> + +<p>August 30, 2001 +<br>Van Dixon +<br>calfuse.h 1.123 +<BR>cf_make_ttag_bkgd + +<br> +<p> +New cf_make_ttag_bkgd iteratively fits dark-count and scattered-light +components of the background to deal with the fact that the dark count +varies with time. Spits out a file filled with zeros if MKBK_COR +is set to OMIT. +<P> +New wavelength calibration files. Updated CALFUSE version to 2.0.3. + +<hr WIDTH="100%"> + +<p>August 23, 2001 +<br>Van Dixon +<br>calfuse.h 1.122 +<br>cf_fuv_init +<br>cf_ttag_burst +<br>cf_ttag_walk +<br>cf_hist_walk +<br>cf_astig +<BR>cf_make_hist_bkgd +<BR>cf_make_ttag_bkgd +<BR>cf_bkgd + +<br> +<p> +Replaced keyword TBURST with EXP_BRST in cf_ttag_burst. +<p> +Enable user to turn off the burst rejection, walk correction, +background subtraction, or astigmatism correction by changing keywords +in parm**006.fit. cf_fuv_init reads the PARM file and changes the +appropriate keywords (e.g., BRST_COR) from PERFORM to OMIT. Subsequent +pipeline steps check their keyword; if it is OMIT, they change the +value to SKIPPED, issue a warning, and exit, copying input to output if +appropriate. Updated CALFUSE version to 2.0.2. + +<hr WIDTH="100%"> + +<p>August 21, 2001 +<br>Van Dixon +<br>calfuse.h 1.121 +<br>cf_wcal +<br>cf_fpa_pos +<br>cf_ttag_init + +<br> +<p> +Moved cf_fpa_pos from cf_wcal to libcf. ttag_combine uses this routine +to determine the FPA positions and complains if an FPA moves by more +than 10 microns between exposures. + +<hr WIDTH="100%"> + +<p>August 20, 2001 +<br>Van Dixon +<br>calfuse.h 1.120 +<br>cf_ttag_init +<br>cf_dtcor + +<br> +<p> +Header keywords SPECBINX and SPECBINY should be 1 for ttag data. An +old version of OPUS set these to 0. Changed cf_ttag_init to update +these parameters if it finds them equal to 0. Also updated cf_dtcor to +use Dave Sahnow's new parameters for dead-time correction. Added a +check: if DET_DEAD > 2.0, assume it's wrong and set to 1.0. + +<hr WIDTH="100%"> + +<p>July 25, 2001 +<br>Van Dixon +<br>calfuse.h 1.119 +<br>cf_astig.c + +<br> +<p> +New version of cf_astig employs Sylvester's cross-correlation routine +to determine spectral centroids. New PHAM, WAVE, and FLUX files. +Updated CALFUSE version to 2.0.1. +<br><font color=red>This is the beta-test version of CalFUSE v2.0.</font> + +<hr WIDTH="100%"> + +<p>July 2, 2001 +<br>Van Dixon +<br>calfuse.h 1.118 +<br>cf_ttag_init.c +<br>cf_ttag_screen.c +<br>cf_ttag_burst.c +<br>cf_make_ttag_bkgd.c +<br>cf_make_hist_bkgd.c + +<br> +<p> +Implemented Richard's new background modeling routine, which +independently computes the day- and night-time contributions to the +scattered-light background. To do so, he adds an extra column, DNFLG, +to all of the photon-event files. Package includes improvements +to the burst-screening algorithm. Updated CALFUSE version to 2.0.0. + +<hr WIDTH="100%"> + +<p>June 29, 2001 +<br>Van Dixon +<br>calfuse.h 1.114 +<br>lsrd_vel.c +<br>lsrk_vel.c + +<br> +<p> +Changed sign returned by the LSR correction subroutines to conform with +astronomical standard. Updated CALFUSE version to 1.9.9 + +<hr WIDTH="100%"> + +<p>June 19, 2001 +<br>Jeff Kruk +<br>helio_vel.c +<p> +Alex Fullerton determined that we have been applying the heliocentric +velocity correction with the wrong sign. The orbital dopper correction +has been applied with the correct sign. The function helio_vel.c +inverts the sign returned by the SLALIB routines, so the simplest +correction is to remove this sign inversion. + +<hr WIDTH="100%"> + +<p>April 10, 2001 +<br>Van Dixon +<br>calfuse.h 1.111 +<br>cf_hist_walk.c 1.1 +<br>cal_fuse_exp_hist.csh + +<br> +<p> +Installed new module to apply walk correction to histogram data. +Modified shell script cal_fuse_exp_hist.csh to call this routine. +Added PHAM entry to CALIBRATION_FILE_KEYS in calfuse.h. Updated +CALFUSE version to 1.9.8 + +<hr WIDTH="100%"> + +<p>April 2, 2001 +<br>Van Dixon +<br>calfuse.h 1.110 +<br>cf_ttag_walk.c 1.1 +<br>cal_fuse_exp_ttag.csh +<br>cal_fuse_exp_hist.csh + +<br> +<p> +Installed new module to apply walk correction. Modified shell +scripts cal_fuse_exp_ttag.csh and cal_fuse_exp_hist.csh to call this +routine. Added WALK entry to CALIBRATION_FILE_KEYS in calfuse.h. +Updated CALFUSE version to 1.9.7 + +<hr WIDTH="100%"> + +<p>March 28, 2001 +<br>Van Dixon +<br>calfuse.h 1.109 +<br>cf_extract.c 1.52 +<br>cal_fuse_exp_ttag.csh +<br>cal_fuse_exp_hist.csh + +<br> +<p> +Installed new module to perform optimal extraction. Modified shell +scripts cal_fuse_exp_ttag.csh and cal_fuse_exp_hist.csh to call this +routine. In calfuse.h, added definition of cf_optextract and new +arguments to cf_spextract. Updated CALFUSE version to 1.9.6 + +<hr WIDTH="100%"> + +<p>March 27, 2001 +<br>Van Dixon +<br>calfuse.h 1.108 +<br>cf_make_bkgd.c 1.22 +<br>cal_fuse_exp_ttag.csh +<br>cal_fuse_exp_hist.csh + +<br> +<p> +Installed new module to scale background calibration file. Modified +shell scripts cal_fuse_exp_ttag.csh and cal_fuse_exp_hist.csh to call +this routine (instead of cf_make_bkgd_temp). Add AIRG entry to +CALIBRATION_FILE_KEYS in calfuse.h. Updated CALFUSE version to 1.9.5 + +<hr> + +<p>March 19, 2001 +<br>Van Dixon +<br>calfuse.h 1.107 +<br>cf_ttag_burst.c 1.9 +<br>cal_fuse_exp_ttag.csh +<br>cal_fuse_exp_hist.csh + +<br> +<p> +Installed new module to reject data during detector bursts. Modified +shell scripts cal_fuse_exp_ttag.csh and cal_fuse_exp_hist.csh to call +this routine. Modified Makefiles to install it. Updated CALFUSE +version to 1.9.4 + +<hr> +<p>March 14, 2001 +<br>Van Dixon +<br>calfuse.h 1.106 +<br>cf_astig.c 1.8 +<br>cal_fuse_exp_ttag.csh +<br>cal_fuse_exp_hist.csh + +<br> +<p> +Installed new program to implement astigmatism correction, now called cf_astig. +Modified shell scripts cal_fuse_exp_ttag.csh and cal_fuse_exp_hist.csh to call +this routine. Modified Makefiles to install it. +Updated CALFUSE version to 1.9.3 + +<hr> +<p>February 9, 2001 +<br>Jeff Kruk +<br>calfuse.h 1.105 +<br>cf_ttag_screen.c 1.55 + +<br> +<p> +Add checks to cf_ttag_screen.c to ensure that user-defined good time intervals +actually fit within the time spanned by the dataset, and that in each case the +end of a good time interval is later than the beginning. Invalid user GTI's +are ignored. Also added printout to trailer file of the number of events that +were rejected by pulse height limits. Updated CALFUSE version to 1.9.2 + +<hr> +<p>February 8, 2001 +<br>J.C. Hsu +<br>calfuse.h 1.104 +<br>cf_linear.c 1.0 +<br>cf_transform1d.c 1.0 +<br>cf_1dff.c 1.0 +<br>cf_make_1dff.c 1.0 + +<br> +<p> +Install programs needed to perform 1-D flat fielding. All Makefiles updated. +The "official" pipeline shell scripts were not updated; users wishing to try +the 1-D flatfields should edit their local copies of the shell scripts for +the time being. Thus, the pipeline version was not updated. + +<hr> +<p>December 21, 2000 +<br>Paul Barrett, J.C. Hsu +<br>Makefile.Alpha +<br>cf_ttag_screen.c 1.54 +<br>cf_ttag_image.c 1.22 +<br>cf_ttag_init.c 1.16 +<br>cf_wcal.c 1.25 + +<br> +<p> +In response to problems encountered by Vincent LeBrun installing +calfuse on a DEC Alpha running True64, we made a number of changes. +The main one was to correct type mismatches in cfitsio calls: +in a number of cases an "int" variable was referenced as TLONG and vice versa. +Added -ieee flag to compiler options in Makefile.Alpha. +cf_ttag_image: fix type mismatches in cfitsio calls +cf_ttag_init: fix type mismatches in cfitsio calls +cf_ttag_screen: fix type mismatches in cfitsio calls +cf_wcal: fix type mismatches in cfitsio calls +This is the first instance in which v1.9.1 differs from v1.8.7, and no +change in functionality was involved, so the pipeline version was +not updated. + +<hr> +<p>November 15, 2000 +<br>Jeff Kruk +<br>cf_make_ff_temp.c 1.6 +<br>cf_make_bkgd_temp.c 1.6 +<br>cf_ttag_screen.c 1.53 + +<br> +<p> +Fixed typos in print statements in several routines. +No change in functionality resulted, so the pipeline version number +was not incremented. + +<hr> +<p>October 19, 2000 +<br>Jeff Kruk +<br>CALFUSE 1.9.1 +<br>calfuse.h 1.103 + +<br> +<p> +Created CALFUSE version 1.9.1 as the new development version. +calfuse.h was updated to reflect the new version number. + +<hr> +<p>October 18, 2000 +<br>Martial Andre, Jeff Kruk +<br>cf_extract.c 1.47 +<br>calfuse.h 1.102 + +<br> +<p> +The image centroid (in Y) for extended sources is once again calculated +including airglow lines. In many cases extended sources are very faint +and the airglow will help locate the spectra. Extended sources will +ordinarily fill the slits in the same manner as airglow, so the accuracy +of the centroid calculation will not be adversely affected. +<p> +Changed CALFUSE version to 1.8.7. + +<hr> +<p>October 13, 2000 +<br>Jeff Kruk +<br>cf_ttag_screen.c 1.52 +<br>cf_extract.c 1.46 +<br>cf_fuv_init.c 1.9 + +<br> +<p> +Three calls to FITS_read_key (infits, TSTRING, keyword, &arrayname,...) in the +program cf_ttag_screen were modified to remove the extraneous ampersand. +<p> +One call to FITS_read_key (infits, TSTRING, keyword, &arrayname,...) in +cf_extract.c was modified to remove the extraneous ampersand. Also +fixed a bug in the test for the variable ystop_bis being out of limits. +<p> +CF_VER_NUM was brought up to date in cf_fuv_init.c + +<P>These changes are too small to update the version number of the pipeline. + +<hr> +<p>October 2, 2000 +<br>Jeff Kruk, JC Hsu +<br>cf_hist_dopp 1.25 +<br>calfuse.h 1.101 +<br>cal_fuse_exp_ttag.csh +<br>cal_fuse_exp_hist.csh + +<br> +<p> +The program cf_hist_dopp was modified to incorporate corrections for +grating thermal motion. The mean motion for the exposure is added to +the doppler correction. +<p> +The shell script cal_fuse_exp_hist.csh was +modified to call cf_make_shift and to pass the resulting shift file +to cf_hist_dopp. +<p> +The include file calfuse.h was modified to include the function prototype +for lif_sic_border() (see below), and to change the MKSH_COR +histogram pipeline entry in CALIBRATION_STEP_KEYS to PERFORM. +<p> +The shell scripts cal_fuse_exp_ttag.csh and cal_fuse_exp_hist.csh were +modified to test cfstat before calling the idlplot routines. + +<P>The pipeline version number was incremented to 1.8.6. + +<hr> +<p>October 2, 2000 +<br>Jeff Kruk +<br>cf_check_point 1.17 +<br>cf_hist_screen 1.21 +<br>cf_ttag_screen 1.51 + +<br> +<p> +The programs cf_hist_screen and cf_ttag_screen were modified to +update the keyword EXPNIGHT, newly created to provide the number of +seconds of exposure time (after screening) that were obtained during +the night side of the oribt. This keyword will be used by an upcoming +version of cf_bkgd. +<p> +The function cf_check_point was modified to return a flag indicating +whether the satellite was in daylight or night at the time being +checked. + +<P>The pipeline version number was updated for an additional change made +later in the day. + +<hr> +<p>October 2, 2000 +<br>Jeff Kruk, JC Hsu +<br>lif_sic_border() 1.00 + +<br> +<p> +The function lif_sic_border() was extracted from cf_hist_dopp.c +and make a function in libcf so that it would be available for +the upcoming 1-D version of cf_ff. The libcf Makefiles were modified +accordingly. + +<P>No change in functionality resulted, so no update to the pipeline +version number was made. + +<hr> +<p>October 2, 2000 +<br>Jeff Kruk +<br>state_limb 1.08 + +<br> +<p> +The function state_limb() was modified (v1.08) to include fortran +function prototype wrappers for the new slalib calls introduced by +the previous change (slaDcc2s, slaEvp, slaDranrm). + +<P>This change was solely for running Make on the distribution version +of calfuse, so no update to the pipeline version number was made. + +<hr> +<p>September 26, 2000 +<br>Martial Andre +<br>state_limb 1.05, 1.06, 1.07 +<br>cf_check_point 1.16 +<br>cf_orbit 1.03 +<br>calfuse.h 1.98, 1.99, 1.100 + +<br> +<p> +The function state_limb() was modified (v1.05) to calculate the limb angle +constraint in the same way as is done by the mission planners: +it checks if the limb itself is in daylight or night, rather than the +old simplistic method of seeing if the satellite was in day or night. +This required a modification to the call to state_limb. +Versions 1.06, 1.07 of state_limb were to fix minor bugs. +<p> +The function cf_check_point (v1.16) and the program cf_orbit (v1.03) were +modified to make use of this new limb angle constraint calculation. +<p> +The include file calfuse.h (v1.98, v1.99) was modified to provide the +proper function prototype for the new versions of state_limb and +cf_check_point. + +<P>These changes led to the increase in pipeline version number to 1.8.5 +(implemented by version 1.100 of calfuse.h). + + +<hr> +<p>September 18, 2000 +<br>Ed Murphy +<br>Pipeline Distribution Version + +<br> +<p> +Ed Murphy & Paul Barrett produce distribution version of pipeline. +Major change was to incorporate "makemake" files. + +<P>Update the version number of the pipeline to v1.8.4. + +<hr> +<p>September 18, 2000 +<br>Ed Murphy +<br>cf_astig2 1.07 + +<br> +<p> +Ed made some change, not documented in the header. + +<P>Since this routine is still in testing, I have not updated the +pipeline version number. The new version of cf_astig2.c is 1.07. + + +<hr> +<p>September 6, 2000 +<br>Jeff Kruk +<br>cf_dtcor 1.18 + +<br> +<p> +Jeff Kruk modified cf_dtcor.c to populate three new keywords +in the FUV header: +DEAD_DET Detector dead time factor +DEAD_IDS IDS dead time factor +DEAD_TOT Combined dead time factor + +New version of cf_dtcor.c is 1.18. He also changed sunmath.h to math.h. + +<P>These changes are too small to update the version number of the pipeline. + +<hr> +<p>September 5, 2000 +<br>Ed Murphy +<br>cf_astig2 1.06 + +<br> +<p> +Modify cf_astig2 to get the calibration file from the ASTG_CAL keyword +rather than being hardcoded. + +<P>Since this routine is still in testing, I have not update the +pipeline version number. The new version of cf_astig2.c is 1.06. + +<hr> +<p>August 25, 2000 +<br>Ed Murphy +<br>cf_astig2 1.05 + +<br> +<p> +Jeff Kruk found that cf_astig2 crashed on all segment 1B data. The +routine lacked any boundary checking and was running off the bottom +of the image when attempting to centroid the SiC spectrum. The +centroiding routines have been updated to include boundary checking. + +<P>I also added the ability for the routine to check the number +of arguments. + +<P>Since this routine is still in testing, I have not update the +pipeline version number. The new version of cf_astig2.c is 1.05. + +<hr> +<p>August 23, 2000 +<br>Martial Andre +<br>cf_extract 1.44 + +<br> +<p> +Martial fixed a bug in the initialization of column_sum that caused a +fatal bus error. +The change is too small to update the pipeline version number. +<P> + +<hr> +<p>August 18, 2000 +<br>Ed Murphy +<br>cf_update_qual 1.03 + +<br> +<p> +I added calls to cf_proc_check and cf_proc_update to cf_update_qual +to rid the trailer files of the warnings concerning the QUAL_COR +keyword. New version of cf_update_qual is 1.03. The change is too +small to update the pipeline version number. +<P> + +<hr> +<p>August 14, 2000 +<br>Martial +<br>cf_extract 1.43 + +<br> +<p> +To avoid the centroid to be shifted close to the bright edge, the procedure should compute the size of +the scanning window for each different channel (the changes done in version 1.41 were wrong!!!) +<P> + +<hr> +<p>August 13, 2000 +<br>Martial +<br>cf_coadd 1.17 + +<br> +<p> +Propagation of quality should have been done with float since the very beginning (now fixed). +<P> + +<hr> +<p>August 9, 2000 +<br>Martial +<br>cf_extract 1.42 + +<br> +<p> +Added a define statement to use sunmath only ifdef SOLARIS. +<P> + +<hr> +<p>July 26, 2000 +<br>J. C. Hsu, R. Robinson, Ed Murphy +<br>cf_update_qual v1.02 +<br>cf_driftcorr2 v1.23 + +<p>J. C. Hsu has written a program cf_update_qual to update the quality +flags in the *_img.fit files after the drift correction has been +determined. The FARF positions of the dead spots and edges of the detectors +were determined by Rich Robinson and are in the qual*001.fit calibration +files. The drift correction is used to correct for the strecth/shift +in going from the FARF to the observed data frame. + +<p>When implementing cf_update_qual, Ed Murphy noticed that cf_driftcorr2 +was centroiding the stims incorrectly. The error arose because the +algorithm was computing the stim centroid in a box that had an extent +of +-256 in X. Since the stims are at pixel ~230 (on segment 1a) the +centroiding box was including counts along the X=0 column, which +skewed the centroid. In the particular observation that he used +to test the routine (M999 flat field) the X=0 column was particularly +bright due to the high count rates in a stim lamp observation. This +problem probably does not effect most observations, since the X=0 column +is normally much weaker. He also modified cf_driftcorr2 to use the +FARF stim positions given in calfuse.h as opposed to the positions that +were hard coded into the routine. +<P> +Ed Murphy created V1.8.3. + +<hr> +<p>July 21, 2000 +<br>Martial +<br>cf_extract 1.41 + +<br> +<p> +Fixed bug of implementation of a pointer in im_centroid wich caused a bus error. +<P> + +<hr> +<p>June 27, 2000 +<br>Jeff Kruk +<br>cf_dtcor v1.17 + +<p>Jeff Kruk added an IDS dead time correction to the dead time correction +routine cf_dtcor.c. + +<P> +Ed Murphy created V1.8.2 and V1.7.8. + +<hr> +<p>June 26, 2000 +<br>Martial +<br>cf_coadd v1.15 + +<p>Now the default resolution of the coadded spectra is 0.1 Angstrom. This way, +we make sure that astronomers outside JHU don't use them for science purpose +(since some of the channels are currently misaligned => artefacts). Note that +the user is still free to have maximal resolution by tuning the arguments. + +<hr> +<p>June 20, 2000 +<br>Ed Murphy +<br>cf_ttag_screen 1.49, cf_hist_dopp v1.23 +<br>PR 41926 + +<br> +<p> +Peter Young noticed that the Doppler shift in pixels for the SiC and +LiF spectra on segment 1a were both in the same direction. Since the +dispersions run in opposite directions, the two shifts should be opposite +in sign. The DISPAPIX keyword in the wavelength calibration file records +the average dispersion in Angstroms/pixel. It should be positive when +the wavelength increases with increasing pixel number and it should be +negative when the wavelength decreases with increasing pixel number +(SiC1 and LiF2). However, I found that the DISPAPIX keyword was always +positive in the recent versions of the wavelength calibration files. +Therefore, for SiC1 and LiF2, the sign of the Doppler and heliocentric +corrections are incorrect. + +<P> +I have modified the code in cf_ttag_screen and cf_hist_dopp to read in +the absolute value of DISPAPIX and compute the sign of the shift based +on the aperture to which the photon belongs. The new version of +cf_ttag_screen is 1.49 and the new version of cf_hist_dopp is 1.23. + +<P> +I have also removed the flat-fielding step from the pipeline. Even +though we do not have a flat-field file, we have been applying a flat +field (filled with 1's) to the data so that we could incorporate a bad +pixel mask. However, we are not stretching/shifting the flat field file +(since it is all 1's) to match the data which means that the bad pixel +mask does not line up with the data. J.C. Hsu is in the process of +writing a new module to properly apply the bad pixel mask. However, +the routine cf_ttag_geodopp.c still requires the _ff.fit file, so we +must still run cf_make_ff_temp. This intermediate _ff.fit data file +contains all 1's over the active area of the detectors, and 0's +everywhere else. Since we are not running the cf_ff, the locations +where the flat field is 0 are not being flagged as bad. This was +causing cf_ttag_geodopp to report a lot of "Divide by zero in ffbuf" +errors. For now, I have turned off the warning in cf_ttag_geodopp. + +<P> +Ed Murphy created V1.8.1 and V1.7.7. + +<hr> +<p>June 13, 2000 +<br>Martial +<br>cf_extract 1.40 +<br> + +<br> +<p> +The algorithm of finding the centroid has been totally changed. Now the position +of the spectrum is reached via a maximisation of the flux in the extraction window. +Moreover, the airglows are systematically screened to center only on the source. + +<hr> +<p>June 9, 2000 +<br>Martial +<br>cf_extract 1.39 + +<br> +<p> +Airglow screened while computing the centroid. +<P> +<hr> +<p>June 9, 2000 +<br>Martial +<br>cf_extract 1.38 + +<br> +<p> +Major change to calculate the centroid. Center is reached for flux maximum. +<P> +<hr> +<p>June 4, 2000 +<br>Martial +<br>Version 7 of the extraction windows +<br> + +<br> +<p> +The way the windows are calculated changed drastically. Using the parameter of the distortion +correction, the shape of each window has been simplified (butterfly or trapeze) and the +weigth files are filled with parabolic profiles (first approximation). For more details +see /data1/fuse/calfuse/v1.8/src/cal/extraction_masks/README + + +<hr> +<p>May 24, 2000 +<br>Martial +<br>cf_extract 1.37 + +<br> +<p> +Added a define statement for the cpp and DEC +<P> +<hr> +<br> +<hr> +<p>May 18, 2000 +<br>Jeff Kruk, Ed Murphy +<br>cf_wcal 1.24 + +<br> +<p> +Jeff Kruk upgraded cf_wcal to read either the new FPA keywords (FPASXPOS +or FPALXPOS) or the old keywords (FP1SXPOS, FP1LXPOS, FP2SXPOS, or +FP2LXPOS). New version is 1.24. +<P> +Ed Murphy created V1.8.0. + + +<hr> +<p>May 17, 2000 +<br>Jeff Kruk, Ed Murphy, Paul Barrett +<br>CALFUSE v1.7.6 + +<br> +<p> +Jeff Kruk has completed the new version of cf_dtcor. +<P> +Ed Murphy found and corrected a bug in cf_extract that prevented the +SiC extraction windows from being reset to the default position if +the centroid was more than EMAX_SIC pixels from the exptected position. +<P> +Paul Barret changed the interpolation algorithm back to a constant (to +prevent ringing around the outside of the spectrum) and fixed a bug in +that implementation. + +<hr> + +<p>May 12, 2000 +<br>Jeff Kruk, Paul Barrett +<br>CALFUSE v1.7.5 + +<br> +<p> +Jeff Kruk has modified cf_wcal.c (now version 1.23) to correct the +wavelength scale for the position of the FPA. +<P> +Paul Barrett has produced new versions of the detector distortion +files: geom*005.fit in /data1/fuse/calfuse/calfiles. + +<hr> + +<p>April 24, 2000 +<br>Ed Murphy +<br>CALFUSE v1.7.4 + +<br> +<p> +The pipeline can now generate a few diagnostic plots (using IDL) while +it is running if the CF_IDLDIR environment variable is set to point to +the location of the IDL programs. To set up the pipeline to make the +plots, add the following to your .cshrc or .login file:<BR> +setenv CF_IDLDIR '/data1/fuse/calfuse/current/idl/' +<P> +The plots are in GIF format so that they can, at some future time, +be linked to the SDOG pages. +<hr> +<p>April 24, 2000 +<br>Ed Murphy +<br>CALFUSE v1.7.4 + +<br> +<p> +Development on V1.7.4 of the pipeline has been frozen. Only bug fixes +will be made from now on. The current stable version of the pipeline +now points to V1.7.4. You will need new calibration files, new +parameter files, and a new master_calib_file.dat +<P> +Upgrades (besides those listed in previous messages) include: +<ol> +<li> Both the code (V1.7.*) and calibration files are now in the +Flight Alignment Reference Frame. This means that the stretch and +shift has been reduced from about 120 pixels in X to less than 10 +pixels in X. +<li> Improved wavelength calibration from Don Lindler. +<li> Improved flux calibration from Jeff Kruk. +<li> Improved distortion correction from Paul Barrett. +<li> The user now has the ability to scale the background by a simple +scalar value when using pulse height screening. The value to scale +the background is in the PHA_BKGD keyword in the screening parameter +file. +<li> The user now has the ability to limit the motion of the spectral +extraction windows based on the pipeline determined centroid. If the +difference between the expected and actual positions is larger than +the limit, the pipeline defaults to the expected position. The limit +is set using the EMAX_LIF and EMAX_SIC keywords in the parm**002.fit +files. +<li> The user now has the ability to ignore the pipeline determined +centroid and place the extraction windows where ever they wish using +the SPEX_SIC and SPEX_LIF keywords in the parm**002.fit files. Note +that the maximum motion limit described above still applies. +</ol> + +<hr WIDTH="100%"> + +<p>March 24, 2000 +<br>Paul Barrett +<br>CALFUSE v1.7.4 +<br>PR 41000 +<p>It has been suggested that a higher order interpolation scheme be used +when expanding the binned histogram data, instead of the current constant +interpolation scheme. A quadratic average interpolation algorithm has been +implemented in cf_hist_init. This algorithm uses data from neighboring +pixels to interpolate the data in binned pixles while conserving the total +number of counts per binned pixel. This routine has been tested. +<p>This modification to cf_hist_init will now allow histogram data to be +used for determining distortion corrections by providing necessary spatial +resolution. +<hr WIDTH="100%"> +<p>March 7, 2000 +<br>Ed Murphy +<br>CALFUSE V1.6.9 and V1.7.3 +<br>PR 40864 + +<p STYLE="margin-bottom: 0in">In the SDOG report for P1320101 Jeff Kruk +found that the pipeline seemed to be excessively screening out data that +was near, but not violating, the night time limb angle limit. I found flawed +logic in the limb angle check in cf_check_point.c that meant that the bright +limb angle was always used regardless of the day/night flag. The problem +has been corrected (cf_check_point.c now V1.15) and the routine has been +tested. +<br> +<hr> +<p>February 10, 2000 +<br>Ed Murphy +<br>CALFUSE V1.6.8 and V1.7.2 +<br>PR 40661 + +<p STYLE="margin-bottom: 0in">Bill Oegerle noticed that the pipeline was +not subtracting the background from some recently processed datasets. The +pipeline has been in this state since sometime around the end of December +1999. I fixed the problem in both versions of the pipeline: new versions +are V1.6.8 and V1.7.2 +<p>The problem was found in cf_make_bkgd_temp.c, which is a temporary module +designed to read in the background calibration file and write it into the +*ttagf_bkgd.fit file needed by the pipeline. The module does not stretch +or shift the background image but does scale the background by the integration +time. In the calibration file, the background image is composed of short +integers with the value 1 everywhere. The keyword BSCALE gives the number +of square cm per pixel, so that the file contains the number of counts +per pixel per second. The original version of cf_make_bkgd_temp.c read +in the calibration image and wrote it out directly, without converting +the input image to floats. All it did was multiply BSCALE by the integration +time, so that when cf_bkgd.c read in the file and scaled by BSCALE, the +resulting image would be background counts per pixel for the full integration. +<p>In late December 1999, it was decided to rewrite cf_make_bkgd_temp.c +to rebin the data for histogram mode observations. In this case, the new +routine read in the calibration file array (all 1), converted the background +image to floats by applying BSCALE, rebinned the data (if necessary), and +wrote out an array of floats. However, the header was copied from the input +file, so the BSCALE keyword still remained even though the data had already +been scaled as part of the routine. In addition, the step where BSCALE +was multiplied by the integration time also remained in the new version. +Therefore, when cf_bkgd.c read in the *ttagf_bkgd.fit intermediate file, +it used the BSCALE keyword a second time. The result was that the subtracted +background was about two orders of magnitude too small. +<p>Because the pipeline now unbins the histogram data, we have reverted +back to the original versions of the routines which do not rebin the data +and do not suffer from this problem. The new version of cf_make_bkgd_temp.c +is V1.4. +<hr> +<p>February 1, 2000 +<br>Ed Murphy +<br>CALFUSE V1.6.7 and V1.7.1 +<br>PR 40541 + +<p STYLE="margin-bottom: 0in">A few histogram data sets were crashing the +pipeline becuause of a bad pixel value that was larger than 32767. This +value was large enough that it would not fit into a short integer in the +pipeline and cfitsio would return a data conversion error. Jim Rose has +agreed to modify the OPUS pipeline to find pixel values larger than 32767 +and change them to the data fill value 21865. As seen below, the pipeline +will convert the data fill value to 0.0 and change its quality flag to +bad. +<hr> +<p>February 1, 2000 +<br>Ed Murphy +<br>CALFUSE V1.6.7 and V1.7.1 +<br>PR 40544 + +<p STYLE="margin-bottom: 0in">A number of histogram data sets have fill +data in them (decimal 21865) which the pipeline was not filtering out. +I have modifed v1.6.7 and v1.7.1 of the pipeline to check pixels for the +fill data value. If the fill data value is found, it will replace the data +with 0.0 and change the quality flag to bad. +<hr> +<p>January 31, 2000 +<br>Ed Murphy +<br>CALFUSE V1.6.7 and V1.7.1 +<br>PR 40553 + +<p STYLE="margin-bottom: 0in">Until now, the DATE keyword in the header +was not modified by any of the modules in the pipeline, even though its +comment stated that it was the "date the file was written." I have modified +cf_proc_update.c to update the DATE keyword. Since cf_proc_update is called +at the end of each module of the pipeline, the output files and all intermediate +data products will now have accurate dates and times in the DATE keyword. +This change was made to both V.1.6.7 and V1.7.1 of the pipeline. +<hr> +<p>January 24, 2000 +<br>Martial +<br>CALFUSE V1.6 and V1.7 + +<p STYLE="margin-bottom: 0in">CENTROIDING PROBLEMS FIXED : + +<p STYLE="margin-bottom: 0in">Until now, the cf_extract procedure was unable +to perform a good centroiding in Y when very few counts were involved. +Since we used the formula : Ycenter = (<font face="symbol">å</font> +Yi * nbcounts_i)/<font face="symbol">å</font>nbcounts_i, where nbcounts_i +is the total number of counts along the row i, the result was depending +on the Y limits of the sum. For instance, if the upper limit equals infinity, +the result is infinity (do not forget that the noise is different of 0). +So, to use this formula, we need a first guess for the position of the +center in order + +<p STYLE="margin-bottom: 0in">to choose a domain of calculation surrounding +it. At present, this first guess is the maximum peak. +<br> +<hr> +<p>January 21, 2000 +<br>Martial +<br>CALFUSE V1.6 and V1.7 + +<p STYLE="margin-bottom: 0in">The new extraction windows are now available +(spex*005.fit). This is the first set of In Orbit Based Extraction Windows +: all the apertures have the same window (based on 100 percent with LWRS). + +<p STYLE="margin-bottom: 0in">The associated weight files are also available +(wgts*003.fit). Note that since the raw windows extracted from In Orbit +Data are very noisy, I had to smooth and correct the geometrical distorsions +, sometimes " by hand ". +<br> +<table BORDER CELLSPACING=3 CELLPADDING=4 > +<caption><COL WIDTH=85><COL WIDTH=85><COL WIDTH=85><THEAD> +<br></THEAD><TBODY> +<br></TBODY></caption> + +<tr VALIGN=TOP> +<th>Detector</th> + +<th>Data Used</th> + +<th>Notes</th> +</tr> + +<tr VALIGN=TOP> +<td>1A (LiF)</td> + +<td>/data2/fuse/CAL/M101/M1010201</td> + +<td>Good </td> +</tr> + +<tr VALIGN=TOP> +<td>1A (SiC)</td> + +<td>/data2/fuse/CAL/M103/M1030303</td> + +<td>Good </td> +</tr> + +<tr VALIGN=TOP> +<td>1B (LiF)</td> + +<td>/data2/fuse/CAL/M101/M1010201</td> + +<td>Corrected by hand : mirror transformation applied</td> +</tr> + +<tr VALIGN=TOP> +<td>1B (SiC)</td> + +<td>/data2/fuse/CAL/M103/M1030304</td> + +<td>Corrected by hand : linear regression for the narrow domain</td> +</tr> + +<tr VALIGN=TOP> +<td>2A (LiF)</td> + +<td>/data2/fuse/CAL/M101/M1010201</td> + +<td>Good</td> +</tr> + +<tr VALIGN=TOP> +<td>2A (SiC)</td> + +<td>/data2/fuse/CAL/M103/M1030304</td> + +<td>Good </td> +</tr> + +<tr VALIGN=TOP> +<td>2B (LiF)</td> + +<td>NOT AVAILABLE</td> + +<td>Here I didn't find a signal strong enough ... I used the old Ground +Based Files + geometrical correction</td> +</tr> + +<tr VALIGN=TOP> +<td>2B (SiC)</td> + +<td>/data2/fuse/CAL/M103/M1030304</td> + +<td>Ground Based Files + geometrical correction</td> +</tr> +</table> + +<div STYLE="margin-bottom: 0in"></div> + + +<p STYLE="margin-bottom: 0in">Note also that you can change the windows +with "cf_modifwindows" wich apply an homothetic factor to the LiF channel +and the SiC channel : + +<p STYLE="margin-bottom: 0in">>cf_modifwindows filename 0.8 (80% for LiF) +0.9 (90% for SiC) +<br> +<hr> +<br> +<br> +<br> +<p>January 5, 2000 +<br>Ed Murphy +<br>CALFUSE V1.6 and V1.7 + +<p STYLE="margin-bottom: 0in">By popular demand, I have written a program +to convert an ASCII file to the 1-D FITS extracted format that comes out +of the pipeline. The program is called ascii2fits and is in the /usr/local/fusesw/calfuse/current/bin +directory. The program takes 3 arguments: Calling sequence:ascii2fits ascii_file +template_fits_file output_fits_file The ASCII file must have six columns: +wavelength (float) flux (float) errors (float) quality flags (int) counts +(float) errors on counts (float) The template FITS file is used to populate +the header keywords. It can be any raw or pipeline processed file. +<br> +<hr> +<p>January 03, 2000 +<br>Paul Barrett +<br>CALFUSE V1.6.5 + +<p STYLE="margin-bottom: 0in">Overlapping pixels are now averaged by cf_hist_geodopp. +This is a temporary fix to minimize the effect on the spectrum due to a +mis-match between the BARF and FARF, i.e. it removes the spikes from the +spectrum. +<br> +<hr> +<p>December 21, 1999 +<br>Ed Murphy +<br>CALFUSE V1.7.1 + +<p STYLE="margin-bottom: 0in">Version 1.7.1 of the pipeline is now in the +FARF frame, however, the calibration files are not. +<br> +<hr> +<p>December 21, 1999 +<br>Ed Murphy +<br>CALFUSE V1.6.5 + +<p STYLE="margin-bottom: 0in">The dead time correction step has been removed +from the pipeline. The new version of pipeline is V1.6.5. The pipeline +module itself was fine. However, Dave Sahnow has found that the on-board +counters behave strangely at low count rates (in addition to behaving strangely +in the SAA). Until this issue is resolved, we will not dead time correct +the data. +<br> +<hr> +<p>December 21, 1999 +<br>Ed Murphy +<br>CALFUSE V1.6.4 + +<p STYLE="margin-bottom: 0in">Histogram data currently show strong spikes +approximately once per Angstrom. This behavior is not unexpected. It comes +from the fact that we have to compress the image in the X direction by +about 110 pixels in order to bring the data into the reference frame of +the calibration files. Until we can redefine the calibration file reference +frame and remake all our calibration files, this behavior will be present +in the data. +<br> +<hr> +<p>December 17, 1999 +<br>Ed Murphy +<br>CALFUSE V1.6.4 +<p>Version 1.6.4 of the CALFUSE pipeline is now frozen. In the future, +only bug fixes will occur. The /usr/local/fusesw/calfuse/current directory +will now point to v1.6. All development will take place in v1.7. +<p>Upgrades include: +<ol> +<div STYLE="margin-bottom: 0in">The histogram pipeline finally works. The +histogram images are, for now, expanded out to 16384x1024 in size to avoid +some of the binning problems we were encountering.</div> + + +<p STYLE="margin-bottom: 0in">The spectral thermal shifts are now removed +from the data using Kathy's algorithm. If you have a local copy of the +calibration files, will need to copy the new version of master_calib_file.dat +from /data1/fuse/calfuse/parmfiles and the new calibration file shft001.fit +from /data1/fuse/calfuse/calfiles. + +<p STYLE="margin-bottom: 0in">In ttag data, the calculated centroid of +the target aperture is used to offset all apertures to account for movememnt +in the Y direction. In the past, each aperture was centroided and offset +independently. However, because of the overlapping spectra on side 2, the +HIRS aperture centroid often caused the HIRS extraction to contain significant +flux from the LWRS aperture. +<p>A large number of small items were taken care of (keyword updates, minor +bug fixes, etc.).</ol> + +<div STYLE="margin-bottom: 0in">REMINDER: Many people directly reference +"v1.5" rather than "current" in their PATH and LD_LIBRARY_PATH. If you +do this, be sure to change both PATH and LD_LIBARARY_PATH to v1.6. Otherwise, +you will be running the pipeline with outdated copies of the library routines +since we are now using dynamically linked libraries (linked in at run time).</div> + +<br> +<hr> + <address><a href="mailto:emurphy@pha.jhu.edu">Ed Murphy</a></address> +<!-- Created: Fri Apr 28 15:14:57 EDT 2000 --> +<!-- hhmts start --> +Last modified: Monday, December 10 2001 +<!-- hhmts end --> + </body> +</html> diff --git a/scripts/.trailer b/scripts/.trailer new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/scripts/.trailer diff --git a/scripts/Makefile.am b/scripts/Makefile.am new file mode 100644 index 0000000..1f3b7d7 --- /dev/null +++ b/scripts/Makefile.am @@ -0,0 +1,30 @@ +bin_SCRIPTS = \ + calfuse.wavecal \ + cf_make_900_obs.csh \ + cf_make_all.csh \ + cf_make_all_obs.csh \ + cfsetup.csh \ + cfsetup.sh \ + idl_obsplot.pl \ + idlplot_rate.pl \ + idlplot_spex.pl \ + listhead \ + listtra + +EXTRA_DIST = cfsetup.csh.in \ + cfsetup.sh.in + +CLEANFILES = cfsetup.csh \ + cfsetup.sh + +do_subst = sed -e 's,[@]DATADIR[@],$(datadir),g' \ + -e 's,[@]PREFIX[@],$(prefix),g' \ + -e 's,[@]VERSION[@],$(VERSION),g' + +cfsetup.csh: cfsetup.csh.in Makefile + $(do_subst) < cfsetup.csh.in > cfsetup.csh + chmod +x cfsetup.csh + +cfsetup.sh: cfsetup.sh.in Makefile + $(do_subst) < cfsetup.sh.in > cfsetup.sh + chmod +x cfsetup.sh diff --git a/scripts/Makefile.in b/scripts/Makefile.in new file mode 100644 index 0000000..57e8ec5 --- /dev/null +++ b/scripts/Makefile.in @@ -0,0 +1,544 @@ +# Makefile.in generated by automake 1.15 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2014 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +VPATH = @srcdir@ +am__is_gnu_make = { \ + if test -z '$(MAKELEVEL)'; then \ + false; \ + elif test -n '$(MAKE_HOST)'; then \ + true; \ + elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ + true; \ + else \ + false; \ + fi; \ +} +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = scripts +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/m4/libtool.m4 \ + $(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \ + $(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +DIST_COMMON = $(srcdir)/Makefile.am $(am__DIST_COMMON) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/src/include/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; +am__install_max = 40 +am__nobase_strip_setup = \ + srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` +am__nobase_strip = \ + for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" +am__nobase_list = $(am__nobase_strip_setup); \ + for p in $$list; do echo "$$p $$p"; done | \ + sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ + $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ + if (++n[$$2] == $(am__install_max)) \ + { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ + END { for (dir in files) print dir, files[dir] }' +am__base_list = \ + sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ + sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' +am__uninstall_files_from_dir = { \ + test -z "$$files" \ + || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ + || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ + $(am__cd) "$$dir" && rm -f $$files; }; \ + } +am__installdirs = "$(DESTDIR)$(bindir)" +SCRIPTS = $(bin_SCRIPTS) +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +SOURCES = +DIST_SOURCES = +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +am__DIST_COMMON = $(srcdir)/Makefile.in +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +ALLOCA = @ALLOCA@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AR = @AR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DLLTOOL = @DLLTOOL@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +F77 = @F77@ +FFLAGS = @FFLAGS@ +FGREP = @FGREP@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ +MAKEINFO = @MAKEINFO@ +MANIFEST_TOOL = @MANIFEST_TOOL@ +MKDIR_P = @MKDIR_P@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PKG_CONFIG = @PKG_CONFIG@ +PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ +PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ +RANLIB = @RANLIB@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +VERSION = @VERSION@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_AR = @ac_ct_AR@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +ac_ct_F77 = @ac_ct_F77@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +cfitsio_CFLAGS = @cfitsio_CFLAGS@ +cfitsio_LIBS = @cfitsio_LIBS@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +bin_SCRIPTS = \ + calfuse.wavecal \ + cf_make_900_obs.csh \ + cf_make_all.csh \ + cf_make_all_obs.csh \ + cfsetup.csh \ + cfsetup.sh \ + idl_obsplot.pl \ + idlplot_rate.pl \ + idlplot_spex.pl \ + listhead \ + listtra + +EXTRA_DIST = cfsetup.csh.in \ + cfsetup.sh.in + +CLEANFILES = cfsetup.csh \ + cfsetup.sh + +do_subst = sed -e 's,[@]DATADIR[@],$(datadir),g' \ + -e 's,[@]PREFIX[@],$(prefix),g' \ + -e 's,[@]VERSION[@],$(VERSION),g' + +all: all-am + +.SUFFIXES: +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign scripts/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign scripts/Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): +install-binSCRIPTS: $(bin_SCRIPTS) + @$(NORMAL_INSTALL) + @list='$(bin_SCRIPTS)'; test -n "$(bindir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(bindir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(bindir)" || exit 1; \ + fi; \ + for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + if test -f "$$d$$p"; then echo "$$d$$p"; echo "$$p"; else :; fi; \ + done | \ + sed -e 'p;s,.*/,,;n' \ + -e 'h;s|.*|.|' \ + -e 'p;x;s,.*/,,;$(transform)' | sed 'N;N;N;s,\n, ,g' | \ + $(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1; } \ + { d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \ + if ($$2 == $$4) { files[d] = files[d] " " $$1; \ + if (++n[d] == $(am__install_max)) { \ + print "f", d, files[d]; n[d] = 0; files[d] = "" } } \ + else { print "f", d "/" $$4, $$1 } } \ + END { for (d in files) print "f", d, files[d] }' | \ + while read type dir files; do \ + if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \ + test -z "$$files" || { \ + echo " $(INSTALL_SCRIPT) $$files '$(DESTDIR)$(bindir)$$dir'"; \ + $(INSTALL_SCRIPT) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \ + } \ + ; done + +uninstall-binSCRIPTS: + @$(NORMAL_UNINSTALL) + @list='$(bin_SCRIPTS)'; test -n "$(bindir)" || exit 0; \ + files=`for p in $$list; do echo "$$p"; done | \ + sed -e 's,.*/,,;$(transform)'`; \ + dir='$(DESTDIR)$(bindir)'; $(am__uninstall_files_from_dir) + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs +tags TAGS: + +ctags CTAGS: + +cscope cscopelist: + + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(SCRIPTS) +installdirs: + for dir in "$(DESTDIR)$(bindir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-libtool mostlyclean-am + +distclean: distclean-am + -rm -f Makefile +distclean-am: clean-am distclean-generic + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: install-binSCRIPTS + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-generic mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-binSCRIPTS + +.MAKE: install-am install-strip + +.PHONY: all all-am check check-am clean clean-generic clean-libtool \ + cscopelist-am ctags-am distclean distclean-generic \ + distclean-libtool distdir dvi dvi-am html html-am info info-am \ + install install-am install-binSCRIPTS install-data \ + install-data-am install-dvi install-dvi-am install-exec \ + install-exec-am install-html install-html-am install-info \ + install-info-am install-man install-pdf install-pdf-am \ + install-ps install-ps-am install-strip installcheck \ + installcheck-am installdirs maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-generic \ + mostlyclean-libtool pdf pdf-am ps ps-am tags-am uninstall \ + uninstall-am uninstall-binSCRIPTS + +.PRECIOUS: Makefile + + +cfsetup.csh: cfsetup.csh.in Makefile + $(do_subst) < cfsetup.csh.in > cfsetup.csh + chmod +x cfsetup.csh + +cfsetup.sh: cfsetup.sh.in Makefile + $(do_subst) < cfsetup.sh.in > cfsetup.sh + chmod +x cfsetup.sh + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/scripts/calfuse.csh b/scripts/calfuse.csh new file mode 100755 index 0000000..4a828d1 --- /dev/null +++ b/scripts/calfuse.csh @@ -0,0 +1,165 @@ +#!/usr/local/bin/tcsh -f +#****************************************************************************** +#* Johns Hopkins University +#* Center For Astrophysical Sciences +#* FUSE +#****************************************************************************** +#* +#* Synopsis: calfuse.csh file_name +#* +#* Description: Shell script for processing FUSE Ver 3.0 time-tagged exposures. +#* All messages are written to stdout or stderr. +#* +#* Arguments: char file_name File name to process is 1st command- +#* line argument +#* +#* Returns: Exit codes: +#* 0 Successful execution +#* +#* +#* Environment variables: CF_CALDIR Path to directory which contains the +#* calibration files. +#* CF_IDLDIR Path to CalFUSE IDL directory +#* CF_PIPELINE Flag to determine if CALFUSE +#* is running as part of the JHU +#* pipeline. +#* +#* History: 02/26/03 1.1 peb Begin work on V3.0 +#* 03/19/03 1.2 wvd Add IDL plots +#* 03/31/03 1.3 peb Add cf_ttag_countmap/gainmap programs +#* and changed the timestamp format to be +#* similar to cf_timestamp +#* 05/16/03 1.4 wvd Distinguish between TTAG and HIST files. +#* Changed name to calfuse.csh +#* 05/22/03 1.5 wvd Direct STDERR to trailer file. +#* 06/03/03 1.6 rdr Incorporated bad pixel map +#* 06/09/03 1.7 rdr Do not screen on timing flags for HIST +#* data processed behind the firewall +#* 07/31/03 1.8 wvd Check error status before exiting. +#* 09/15/03 1.9 wvd Write BEGIN and END stmts to logfile. +#* 12/08/03 1.10 wvd For HIST data, always call +#* cf_extract_spectra and cf_bad_pixels +#* with -s option. +#* 12/21/03 1.13 wvd Remove underscore from idf and bpm +#* filenames. +#* 04/22/04 1.12 wvd Change name of trailer file to +#* {$froot}.trl +#* 05/12/04 1.13 wvd Remove cf_ttag_countmap and +#* cf_ttag_gainmap from pipeline. +#* 06/01/04 1.14 wvd For HIST data, no longer need to call +#* cf_extract_spectra with -s option. +#* 06/03/04 1.15 wvd Screening step now follows "Convert +#* to FARF." +#* +#*****************************************************************************/ + +# Delete files after processing? (Default is no.) +#set DELETE_IDF # Delete intermediate data file +#set DELETE_BPM # Delete bad-pixel map + +set idf = ${1:s/raw/idf/} +set froot = ${1:s/raw.fit//} +set logfile = {$froot}.trl +set ttag = `echo $froot | grep -c ttag` + +# Put a timestamp in the log file (the OPUS trailer file). +if $ttag then + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: Begin TTAG file $1" + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: Begin TTAG file $1" >>& $logfile +else + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: Begin HIST file $1" + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: Begin HIST file $1" >>& $logfile +endif + +set cfstat=0 + +# Step 1 -- Generate Intermediate Data File +if $ttag then + cf_ttag_init $1 $idf >>& $logfile + set cfstat=$status +else + cf_hist_init $1 $idf >>& $logfile + set cfstat=$status +endif + +# Step 2 -- Convert to FARF +if ! $cfstat then + cf_convert_to_farf $idf >>& $logfile + set cfstat=$status +endif + +# Step 3 -- Screen photons +if ! $cfstat then + cf_screen_photons $idf >>& $logfile + set cfstat=$status +endif + +# Step 4 -- Remove motions +if ! $cfstat then + cf_remove_motions $idf >>& $logfile + set cfstat=$status +endif + +if ! $cfstat then + if ($?CF_IDLDIR) then + idlplot_rate.pl {$froot} >>& $logfile + idlplot_spex.pl {$froot} >>& $logfile + endif +endif + +# Step 5 -- Assign wavelength +if ! $cfstat then + cf_assign_wavelength $idf >>& $logfile + set cfstat=$status +endif + +# Step 6 -- Flux calibrate +if ! $cfstat then + cf_flux_calibrate $idf >>& $logfile + set cfstat=$status +endif + +# Step 7 -- Create a bad-pixel file +if ! $cfstat then + cf_bad_pixels $idf >>& $logfile + set cfstat=$status +endif + +# Step 8 -- Extract spectra +if ! $cfstat then + cf_extract_spectra $idf >>& $logfile + set cfstat=$status +endif + +# Step 8a -- Delete _bursts.dat file +if ! $?CF_PIPELINE then + rm -f ${1:r:s/ttagfraw/_bursts/}.dat +endif + +# Step 8b -- Delete IDF file +if $?DELETE_IDF then + echo "NOTE: Deleting intermediate data file." + rm $idf +endif + +# Step 8c -- Delete bad pixel map (bpm) file +if $?DELETE_BPM then + echo "NOTE: Deleting bad pixel map (bpm) file." + rm -f ${1:s/raw/bpm/} +endif + +if ! $cfstat then + if $ttag then + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: End TTAG file $1" + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: End TTAG file $1" >>& $logfile + else + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: End HIST file $1" + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: End HIST file $1" >>& $logfile + endif +else + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: Error processing $1" + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: Error processing $1" >>& $logfile +endif +exit($cfstat) + +#****************************************************************************** diff --git a/scripts/calfuse.sh b/scripts/calfuse.sh new file mode 100755 index 0000000..0cd23a9 --- /dev/null +++ b/scripts/calfuse.sh @@ -0,0 +1,142 @@ +#!/bin/sh +#****************************************************************************** +#* Johns Hopkins University +#* Center For Astrophysical Sciences +#* FUSE +#****************************************************************************** +#* +#* Synopsis: calfuse.sh file_name +#* +#* Description: Shell script for processing FUSE Ver 3.2 time-tagged exposures. +#* All messages are written to stdout or stderr. +#* +#* Arguments: char file_name File name to process is 1st command- +#* line argument +#* +#* Returns: Exit codes: +#* 0 Successful execution +#* +#* +#* Environment variables: CF_CALDIR Path to directory which contains the +#* calibration files. +#* CF_IDLDIR Path to CalFUSE IDL directory +#* CF_PIPELINE Flag to determine if CALFUSE +#* is running as part of the JHU +#* pipeline. +#* +#* History: 09/05/07 1.1 bot Adapted from tcsh script +#* +#*****************************************************************************/ + +# Delete files after processing? (Default is no.) +#DELETE_IDF=1 # Delete intermediate data file +#DELETE_BPM=1 # Delete bad-pixel map + +idf=`echo $1 | sed -e "s/raw/idf/g"` +froot=`echo $1 | sed -e "s/raw.fit//g"` +logfile=${froot}.trl +ttag=`echo $froot | grep -c ttag` + + +# Put a timestamp in the log file (the OPUS trailer file). +if [ $ttag = 1 ]; then + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: Begin TTAG file $1" + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: Begin TTAG file $1" >> $logfile 2>&1 +else + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: Begin HIST file $1" + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: Begin HIST file $1" >> $logfile 2>&1 +fi + +cfstat=1 + +# Step 1 -- Generate Intermediate Data File +if [ $ttag = 1 ]; then + cf_ttag_init $1 $idf >> $logfile 2>&1 + cfstat=$? +else + cf_hist_init $1 $idf >> $logfile 2>&1 + cfstat=$? +fi + +# Step 2 -- Convert to FARF +if [ $cfstat = 0 ]; then + cf_convert_to_farf $idf >> $logfile 2>&1 + cfstat=$? +fi + +# Step 3 -- Screen photons +if [ $cfstat = 0 ]; then + cf_screen_photons $idf >> $logfile 2>&1 + cfstat=$? +fi + +# Step 4 -- Remove motions +if [ $cfstat = 0 ]; then + cf_remove_motions $idf >> $logfile 2>&1 + cfstat=$? +fi + +if [ $cfstat = 0 ]; then + if [ ${CF_IDLDIR:-""} != "" ]; then + idlplot_rate.pl $froot >> $logfile 2>&1 + idlplot_spex.pl $froot >> $logfile 2>&1 + fi +fi + +# Step 5 -- Assign wavelength +if [ $cfstat = 0 ]; then + cf_assign_wavelength $idf >> $logfile 2>&1 + cfstat=$? +fi + +# Step 6 -- Flux calibrate +if [ $cfstat = 0 ]; then + cf_flux_calibrate $idf >> $logfile 2>&1 + cfstat=$? +fi + +# Step 7 -- Create a bad-pixel file +if [ $cfstat = 0 ]; then + cf_bad_pixels $idf >> $logfile 2>&1 + cfstat=$? +fi + +# Step 8 -- Extract spectra +if [ $cfstat = 0 ]; then + cf_extract_spectra $idf >> $logfile 2>&1 + cfstat=$? +fi + +# Step 8a -- Delete _bursts.dat file +if [ ${CF_PIPELINE:-""} = "" ]; then + rm -f `echo $1 | sed -e "s/ttagfraw.fit/_bursts.dat/g"` +fi + +# Step 8b -- Delete IDF file +if [ ${DELETE_IDF:-""} != "" ]; then + echo "NOTE: Deleting intermediate data file." + rm -f $idf +fi + +# Step 8c -- Delete bad pixel map (bpm) file +if [ ${DELETE_BPM:-""} != "" ]; then + echo "NOTE: Deleting bad pixel map (bpm) file." + rm -f `echo $1 | sed -e "s/raw/bpm/g"` +fi + +if [ $cfstat = 0 ]; then + if [ $ttag = 1 ]; then + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: End TTAG file $1" + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: End TTAG file $1" >> $logfile 2>&1 + else + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: End HIST file $1" + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: End HIST file $1" >> $logfile 2>&1 + fi +else + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: Error processing $1" + echo `date '+%Y %b %e %T'` "calfuse.csh-1.15: Error processing $1" >> $logfile 2>&1 +fi + +exit $cfstat + +#****************************************************************************** diff --git a/scripts/calfuse.wavecal b/scripts/calfuse.wavecal new file mode 100755 index 0000000..eae4653 --- /dev/null +++ b/scripts/calfuse.wavecal @@ -0,0 +1,130 @@ +#!/usr/local/bin/tcsh -f +#****************************************************************************** +#* Johns Hopkins University +#* Center For Astrophysical Sciences +#* FUSE +#****************************************************************************** +#* +#* Synopsis: calfuse.wavecal file_name +#* +#* Description: Shell script for processing FUSE Ver 3.0 time-tagged exposures. +#* All messages are written to stdout or stderr. +#* +#* WARNING: THIS VERSION IS OPTIMIZED FOR PROCESSING WAVELENGTH +#* CALIBRATION DATA!!! +#* +#* Arguments: char file_name File name to process is 1st command- +#* line argument +#* +#* Returns: Exit codes: +#* 0 Successful execution +#* +#* +#* Environment variables: CF_CALDIR Path to directory which contains the +#* calibration files. +#* CF_IDLDIR Path to CalFUSE IDL directory +#* CF_PIPELINE Flag to determine if CALFUSE +#* is running as part of the JHU +#* pipeline. +#* +#* History: 02/26/03 1.1 peb Begin work on V3.0 +#* 03/19/03 1.2 wvd Add IDL plots +#* 03/31/03 1.3 peb Add cf_ttag_countmap/gainmap programs +#* and changed the timestamp format to be +#* similar to cf_timestamp +#* 05/16/03 1.4 wvd Distinguish between TTAG and HIST files. +#* Changed name to calfuse.csh +#* 05/22/03 1.5 wvd Direct STDERR to trailer file. +#* 06/03/03 1.6 rdr Incorporated bad pixel map +#* 06/09/03 1.7 rdr Do not screen on timing flags for HIST +#* data processed behind the firewall +#* 07/31/03 1.8 wvd Check error status before exiting. +#* 09/15/03 1.9 wvd Write BEGIN and END stmts to logfile. +#* 12/08/03 1.10 wvd For HIST data, always call +#* cf_extract_spectra and cf_bad_pixels +#* with -s option. +#* 12/21/03 1.13 wvd Remove underscore from idf and bpm +#* filenames. +#* 04/22/04 1.12 wvd Change name of trailer file to +#* {$froot}.trl +#* 05/12/04 1.13 wvd Remove cf_ttag_countmap and +#* cf_ttag_gainmap from pipeline. +#* 06/01/04 1.14 wvd For HIST data, no longer need to call +#* cf_extract_spectra with -s option. +#* 06/03/04 1.15 wvd Screening step now follows "Convert +#* to FARF." +#* +#*****************************************************************************/ + +set idf = ${1:s/raw/idf/} +set froot = ${1:s/raw.fit//} +set logfile = {$froot}.trl +set ttag = `echo $froot | grep -c ttag` + +# Put a time stamp in the log file (the OPUS trailer file). +if $ttag then + echo `date '+%Y %b %e %T'` "calfuse.wavecal-1.15: Begin TTAG file $1" + echo `date '+%Y %b %e %T'` "calfuse.wavecal-1.15: Begin TTAG file $1" >>& $logfile +else + echo `date '+%Y %b %e %T'` "calfuse.wavecal-1.15: Begin HIST file $1" + echo `date '+%Y %b %e %T'` "calfuse.wavecal-1.15: Begin HIST file $1" >>& $logfile +endif + +set cfstat=0 + +# Step 1 -- Generate Intermediate Data File +if $ttag then + cf_ttag_init $1 $idf >>& $logfile + set cfstat=$status +else + cf_hist_init $1 $idf >>& $logfile + set cfstat=$status +endif + +# Step 2 -- Convert to FARF +if ! $cfstat then + cf_convert_to_farf $idf >>& $logfile + set cfstat=$status +endif + +# Step 3 -- Screen photons +if ! $cfstat then + cf_screen_photons $idf >>& $logfile + set cfstat=$status +endif + +# Step 4 -- Remove motions +if ! $cfstat then + cf_remove_motions $idf >>& $logfile + set cfstat=$status +endif + +# Step 5 -- Assign wavelength - SAVE ASTIG-CORRECTED X ARRAY +if ! $cfstat then + cf_assign_wavelength -w $idf >>& $logfile + set cfstat=$status +endif + +if ! $cfstat then + if ($?CF_IDLDIR) then + idlplot_rate.pl {$froot} >>& $logfile + idlplot_spex.pl {$froot} >>& $logfile + endif +endif + +# Step 6 -- Flux calibrate +if ! $cfstat then + cf_flux_calibrate $idf >>& $logfile + set cfstat=$status +endif + +if ! $cfstat then + echo `date '+%Y %b %e %T'` "calfuse.wavecal-1.15: Finish data file $1" + echo `date '+%Y %b %e %T'` "calfuse.wavecal-1.15: Finish data file $1" >>& $logfile +else + echo `date '+%Y %b %e %T'` "calfuse.wavecal-1.15: Error processing $1" + echo `date '+%Y %b %e %T'` "calfuse.wavecal-1.15: Error processing $1" >>& $logfile +endif +exit($cfstat) + +#****************************************************************************** diff --git a/scripts/cf_make_900_obs.csh b/scripts/cf_make_900_obs.csh new file mode 100755 index 0000000..9edbc70 --- /dev/null +++ b/scripts/cf_make_900_obs.csh @@ -0,0 +1,193 @@ +#!/usr/local/bin/tcsh -f + +#****************************************************************************** +#* Johns Hopkins University +#* Center For Astrophysical Sciences +#* FUSE +#****************************************************************************** +#* +#* Synopsis: cf_make_900_obs.csh association_file +#* +#* Description: This routine is derived from cf_make_all_obs.csh, but modified +#* to consider only 900+ (airglow) files. Output is a single +#* quick-look image of the airglow spactrum. +#* +#* Extracted spectra are combined, not IDF files. +#* +#* When an expected data set is missing, the script stops, cleans +#* the directory, and returns 1. +#* +#* History: 08/08/08 1.00 wvd Create separate quick-look image +#* for 900+ (airglow) exposures. +#* Always combine extracted spectra. If +#* cf_xcorr fails, combine with no shift. +#* 08/08/08 1.01 wvd Rename airglow quick-look file to +#* M112580100000airgttagf.gif +#* +#*****************************************************************************/ + +# Delete files after processing? (Default is no.) +#set DELETE_IDF # Delete intermediate data files +set DELETE_BPM # Delete bad-pixel map files + +# Set program path +set rm = "/bin/rm -f" + +set cf_xcorr = cf_xcorr +set cf_combine = cf_combine +set cf_pack = cf_pack +set cf_nvo = cf_nvo +set idl_obsplot = idl_obsplot.pl +set modhead = modhead + +# Init var list +set detector = (1a 2b) +set channel = (lif sic) +set resolution = (2 3 4) +set obsmod = (hist ttag) + +# Determine the root name and the program ID +set asnf = $1 +set rn = ${asnf:s/000asnf.fit//} +set pid = `echo $rn | awk '{print substr($1, 1, 4)}'` + +# Determine the object class +set tmp_file = `ls ${rn}*fcal.fit | awk '{if (NR == 1) print}'` +set tmp_buf = `$modhead $tmp_file OBJCLASS` +set objclass = $tmp_buf[2] + +# Clean tmp files that the script will create (safe) +$rm tmp_xcorr.res tmp_combine.lis +$rm tmp_good_exp.lis tmp_exp.lis tmp_seg_dn.lis +$rm DN_${rn}*.fit + +foreach om ($obsmod) + foreach res ($resolution) + foreach chan ($channel) + foreach det ($detector) + + set ignore_exp_stat = '' + if ($om == hist) set ignore_exp_stat = -a + if ($pid == S100) set ignore_exp_stat = -a + if ($pid == M106) set ignore_exp_stat = -a + + # Find exposures that match the current segment + set seg = $det$chan$res$om + set readfiles = 0 + ls ${rn}9[0-9][0-9]${seg}fcal.fit |& grep -v 000${seg} > tmp_exp.lis # Keep only "9xx" exposures + if ($? == 0) then + set readfiles = 2 + set ignore_exp_stat = -a + endif + + if ($readfiles >= 1) then # There are one or more exposures + + echo " " + echo "*** Processing: $seg ***" + # [1a][lif] -> [1b][lif], [2b][lif] -> [2a][lif] etc... + if ($det == 1a) set det2 = 1b + if ($det == 2b) set det2 = 2a + set seg2 = $det2$chan$res$om + + echo "----- cf_xcorr input -----" + cat tmp_exp.lis + echo "----------------------------" + $cf_xcorr tmp_exp.lis tmp_xcorr.res # Compute shift and sigma_shift + echo "----- cf_xcorr results -----" + cat tmp_xcorr.res + echo "----------------------------" + + awk '{if ($3 >= 0) {print $6, $2} else {print $6}}' tmp_xcorr.res > tmp_good_exp.lis + + # + # --- Path 1: Optimize resolution --- + # + + echo "Optimize resolution..." + set n_good = `cat tmp_good_exp.lis | wc -l` + + # Extract [Day + Night] spectra + set s = DN_${rn}900${seg}fcal.fit + awk '{print "'$rn'"$1"'$seg'fcal.fit",$2}' tmp_good_exp.lis > tmp_combine.lis # Combine $seg [dn] + # echo "----- Combining Files ----- " + # cat tmp_combine.lis + # echo "Output: " $s + $cf_combine -k $ignore_exp_stat tmp_combine.lis $s + # $modhead "${s}[1]" NUM_EXP $n_good + $modhead "${s}[1]" COMBMETH XCORR + echo $s >> tmp_seg_dn.lis + + set s = DN_${rn}900${seg2}fcal.fit + awk '{print "'$rn'"$1"'$seg2'fcal.fit",$2}' tmp_good_exp.lis > tmp_combine.lis # Combine $seg2 [dn] + # echo "----- Combining Files ----- " + # cat tmp_combine.lis + # echo "Output: " $s + $cf_combine -k $ignore_exp_stat tmp_combine.lis $s + # $modhead "${s}[1]" NUM_EXP $n_good + $modhead "${s}[1]" COMBMETH XCORR + echo $s >> tmp_seg_dn.lis + + endif + end + + $rm tmp_xcorr.res tmp_combine.lis + $rm tmp_good_exp.lis tmp_exp.lis + + end + + # Pack the 8 [detector][channel] pairs together + if (-e tmp_seg_dn.lis) then + + set fcal_all = ${rn}00900all$res${om}fcal.fit # Final output name + $rm $fcal_all # Clean (safe) + set n_segs = `cat tmp_seg_dn.lis | wc -l` + + if (!($n_segs == 8)) then + + @ mseg = 8 - $n_segs + echo "ERROR: $mseg (day + night) segments are missing" + $rm tmp_seg_dn.lis + goto crash + + else + + $cf_pack tmp_seg_dn.lis $fcal_all + $rm tmp_seg_dn.lis + + # Plot figures, delete unwanted files + $idl_obsplot {$rn} airglow + mv ${rn}00900spec${om}f.gif ${rn}00000airg${om}f.gif + $rm ${rn}00900lif*.gif ${rn}00900sic*.gif + $rm $fcal_all + + endif + endif + end +end + +# Clean [dn] files. +$rm DN_${rn}*.fit + +# Delete IDF files +if $?DELETE_IDF then + echo "NOTE: Deleting intermediate data files." + $rm ${rn}*idf.fit +endif + +# Delete bad-pixel-map (bpm) files +if $?DELETE_BPM then + echo "NOTE: Deleting bad pixel map (bpm) files." + $rm ${rn}*bpm.fit +endif + +exit(0) + +crash: # Procedure when script crashes + +# Clean directory +$rm tmp_xcorr.res tmp_combine.lis +$rm tmp_good_exp.lis tmp_exp.lis tmp_seg_dn.lis +$rm DN_*.fit + +# Return 1 +exit(1) diff --git a/scripts/cf_make_all.csh b/scripts/cf_make_all.csh new file mode 100755 index 0000000..2cfbc46 --- /dev/null +++ b/scripts/cf_make_all.csh @@ -0,0 +1,487 @@ +#!/usr/local/bin/tcsh -f + +#****************************************************************************** +#* Johns Hopkins University +#* Center For Astrophysical Sciences +#* FUSE +#****************************************************************************** +#* +#* Synopsis: cf_make_all.csh +#* +#* Description: Creates 3 files from a Calfuse output (properly run): +#* +#* 1) An "all" file containing 1 extension per detector (= 8). +#* Each extension contains a combined spectrum from the set +#* of exposures, using "Xcorr" or "Background" method. +#* 2) In the case of TTAG data, creates an "ano" file. Same as +#* the "all" file but considering "night only" exposure time. +#* 3) A National Virtual Observatory "nvo" file. One extension +#* containing wavelengths that span the whole FUSE range. +#* +#* The Xcorr method consists in co-adding spectra, the latter +#* being corrected for a possible shift. The Background method +#* consists in combining all the IDF files. +#* +#* The Xcorr test is performed on 4 (detector, channel) pairs, the +#* method of other pairs are given by them: +#* LiF 1a -> Lif 1b +#* LiF 2b -> LiF 2a +#* SiC 1a -> Sic 1b +#* Sic 2b -> Sic 2a +#* In the script, the left segments are referred as to $seg (or +#* $det) and the right segments are referred as to $seg2 (or +#* $det2). +#* +#* When an expected data set is missing, the script stops, cleans +#* directory, and returns 1. +#* +#* History: 04/15/05 1.0 tc First release +#* +#*****************************************************************************/ + +# Set program path +set rm = "/bin/rm -f" + +set cf_xcorr = cf_xcorr +set cf_combine = cf_combine +set cf_pack = cf_pack +set cf_nvo = cf_nvo +set modhead = modhead + +#set cf_xcorr = /home/vela/civeit/Work/CalFuse/Xcorr/New/cf_xcorr +#set cf_combine = /home/vela/civeit/Work/CalFuse/Shiftexp/cf_combine +#set cf_pack = /home/vela/civeit/Work/CalFuse/Pack/cf_pack +#set cf_nvo = /home/vela/civeit/Work/CalFuse/Nvo/cf_nvo +#set modhead = /home/vela/civeit/local/bin/modhead + +set cf_obsplot = /data1/fuse/calfuse/v3.1/idl/cf_obsplot.pro + + +# Init var list +set detector = (1a 2b) +set channel = (lif sic) +set resolution = (2 3 4) +set obsmod = (hist ttag) + +# Determine the root name +ls [A-Z][0-9][0-9][0-9][0-9][0-9][0-9][0-9]000asnf.fit >& tmp_asnf +if ($? == 0) then + set asnf = `cat tmp_asnf` + set rn = ${asnf:s/000asnf.fit//} + $rm tmp_asnf +else + echo "ERROR: asnf file is missing" + $rm tmp_asnf + goto crash +endif + +# Clean tmp files that the script will create (safe) +$rm tmp_xcorr.res tmp_bpm1.lis tmp_bpm2.lis tmp_combine.lis tmp_night_exp.lis +$rm tmp_all_night_exp.lis tmp_good_exp.lis tmp_exp.lis tmp_seg_dn.lis tmp_seg_no.lis +$rm DN_${rn}*.fit NO_${rn}*.fit + +foreach om ($obsmod) + foreach res ($resolution) + foreach chan ($channel) + foreach det ($detector) + + # Find exposures that match the current segment + set seg = $det$chan$res$om + ls ${rn}[0-8][0-9][0-9]${seg}fcal.fit |& grep -v 000 > tmp_exp.lis # Reject EXP "9xx" and "000" + + if ($? == 0) then # There are one or more exposures + + echo " " + echo "*** Processing: $seg ***" + # [1a][lif] -> [1b][lif], [2b][lif] -> [2a][lif] etc... + if ($det == 1a) set det2 = 1b + if ($det == 2b) set det2 = 2a + set seg2 = $det2$chan$res$om + + echo "----- cf_xcorr input -----" + cat tmp_exp.lis + echo "----------------------------" + $cf_xcorr tmp_exp.lis tmp_xcorr.res # Compute shift and sigma_shift + echo "----- cf_xcorr results -----" + cat tmp_xcorr.res + echo "----------------------------" + + awk '{if ($5 > 0) print $6, $4, $5}' tmp_xcorr.res > tmp_all_night_exp.lis + awk '{if ($3 >= 0) print $6,$2}' tmp_xcorr.res > tmp_good_exp.lis + awk '{if (($3 >= 0) && ($5 > 0)) print $6,$2, $4, $5}' tmp_xcorr.res > tmp_night_exp.lis + set time_good = `awk 'BEGIN{$t = 0} {if ($3 >= 0) $t = $t + $4} END{print $t}' tmp_xcorr.res` + set time_bad = `awk 'BEGIN{$t = 0} {if ($3 < 0) $t = $t + $4} END{print $t}' tmp_xcorr.res` + echo "Xcorr time: $time_good - Background time: $time_bad" + + if ($time_good > 2 * $time_bad) then + + # + # --- Path 1: Optimize resolution --- + # + + echo "Optimize resolution..." + set n_good = `cat tmp_good_exp.lis | wc -l` + + # Extract [Day + Night] spectra + set s = DN_${rn}000${seg}fcal.fit + awk '{print "'$rn'"$1"'$seg'fcal.fit",$2}' tmp_good_exp.lis > tmp_combine.lis # Combine $seg [dn] + $cf_combine tmp_combine.lis $s -k + # $modhead "${s}[1]" NUM_EXP $n_good + $modhead "${s}[1]" COMBMETH XCORR + echo $s >> tmp_seg_dn.lis + + set s = DN_${rn}000${seg2}fcal.fit + awk '{print "'$rn'"$1"'$seg2'fcal.fit",$2}' tmp_good_exp.lis > tmp_combine.lis # Combine $seg2 [dn] + $cf_combine tmp_combine.lis $s -k + # $modhead "${s}[1]" NUM_EXP $n_good + $modhead "${s}[1]" COMBMETH XCORR + echo $s >> tmp_seg_dn.lis + + set n_night = `cat tmp_night_exp.lis | wc -l` + if ($om == ttag && $n_night > 0) then # Create and combine night only files + + echo "*** Creating night only files ***" + set exp_nums = `awk '{print $1}' tmp_night_exp.lis` + + foreach exp ($exp_nums) + + # Create night-only BPM and FCAL files if they do not already exist. + set bno1 = NO_$rn$exp$det${om}fbpm.fit # Bad-pixel maps + set bno2 = NO_$rn$exp$det2${om}fbpm.fit + set cno1 = NO_$rn$exp${seg}fcal.fit # Extracted spectra + set cno2 = NO_$rn$exp${seg2}fcal.fit + + set etime = `egrep "^$exp" tmp_night_exp.lis | awk '{print $3}'` + set ntime = `egrep "^$exp" tmp_night_exp.lis | awk '{print $4}'` + set ratio = `egrep "^$exp" tmp_night_exp.lis | awk '{printf "%.0f", 0.5+$4/$3*10.}'` + + if (!(-e $cno1)) then + if ($etime == $ntime) then + echo "$cno1 is a symbolic link to $rn$exp${seg}fcal.fit" + ln -s $rn$exp${seg}fcal.fit $cno1 + else + + set idf_file = $rn$exp$det${om}fidf.fit + if (!(-e $bno1)) then + if ($ratio > 9) then + echo "$bno1 is a symbolic link to $rn$exp$det${om}fbpm.fit" + ln -s $rn$exp$det${om}fbpm.fit $bno1 + else + echo "Creating BPM: $bno1 ..." + cf_bad_pixels -n $bno1 $idf_file + endif + endif + + echo "Creating (LiF + SiC) FCAL: $cno1 ..." + cf_extract_spectra -n $bno1 -r NO_$rn$exp $idf_file # Existence of $bno1 is not required + endif + endif + + if (!(-e $cno2)) then + if ($etime == $ntime) then + echo "Using a symbolic link to $cno2" + ln -s $rn$exp${seg2}fcal.fit NO_$rn$exp${seg2}fcal.fit + else + + set idf_file = $rn$exp$det2${om}fidf.fit + if (!(-e $bno2)) then + if ($ratio > 9) then + echo "Using a symbolic link to $bno2" + ln -s $rn$exp$det2${om}fbpm.fit NO_$rn$exp$det2${om}fbpm.fit + else + echo "Creating BPM: $bno2 ..." + cf_bad_pixels -n $bno2 $idf_file + endif + endif + + echo "Creating (LiF + SiC) FCAL: $cno2 ..." + cf_extract_spectra -n $bno2 -r NO_$rn$exp $idf_file # Existence of $bno2 is not required + endif + endif + + end + + # Combine exposures into a single spectrum. + set s = NO_${rn}000${seg}fcal.fit + awk '{print "NO_'$rn'"$1"'$seg'fcal.fit",$2}' tmp_night_exp.lis > tmp_combine.lis # Combine $seg [no] + $cf_combine tmp_combine.lis $s -k + # $modhead "${s}[1]" NUM_EXP $n_night + $modhead "${s}[0]" DAYNIGHT NIGHT + $modhead "${s}[1]" COMBMETH XCORR + echo $s >> tmp_seg_no.lis + + set s = NO_${rn}000${seg2}fcal.fit + awk '{print "NO_'$rn'"$1"'$seg2'fcal.fit",$2}' tmp_night_exp.lis > tmp_combine.lis # Combine $seg2 [no] + $cf_combine tmp_combine.lis $s -k + # $modhead "${s}[1]" NUM_EXP $n_night + $modhead "${s}[0]" DAYNIGHT NIGHT + $modhead "${s}[1]" COMBMETH XCORR + echo $s >> tmp_seg_no.lis + + endif + + else + + # + # --- Path 2: Optimize background --- + # + + echo "Optimize background..." + + # Combine IDF files + set idf1_all = DN_${rn}000$det${om}fidf.fit # Same for [dn] and [no] + set idf2_all = DN_${rn}000$det2${om}fidf.fit + + if (!(-e $idf1_all)) then + echo "Creating IDF: $idf1_all ..." + ls ${rn}[0-8][0-9][0-9]$det${om}fidf.fit |& grep -v 000 > tmp_idf.lis # Reject EXP "9xx" and "000" + if ($? == 0) then # IDF files exist + + set idf_lis = `awk '{printf "%s ",$1}' tmp_idf.lis` + idf_combine -c $idf1_all $idf_lis # Create combined IDF file for $seg + $rm tmp_idf.lis + + else + + echo "ERROR: IDF files are missing" + $rm -f tmp_idf.lis + goto crash + + endif + endif + + if (!(-e $idf2_all)) then + echo "Creating IDF: $idf2_all ..." + ls ${rn}[0-8][0-9][0-9]$det2${om}fidf.fit |& grep -v 000 > tmp_idf.lis # Reject EXP "9xx" and "000" + if ($? == 0) then # IDF files exist + + set idf_lis = `awk '{printf "%s ",$1}' tmp_idf.lis` + idf_combine $idf2_all $idf_lis # Create combined IDF file for $seg2 + $rm tmp_idf.lis + + else + + echo "ERROR: IDF files are missing" + $rm -f tmp_idf.lis + goto crash + + endif + endif + + # Get the number of (valid) combined IDF files + set tmp_buf = `$modhead $idf1_all NSPEC` + set n_comb1 = $tmp_buf[3] + set tmp_buf = `$modhead $idf1_all SPEC001` + set idf1_1 = $tmp_buf[3] + set tmp_buf = `$modhead $idf2_all NSPEC` + set n_comb2 = $tmp_buf[3] + set tmp_buf = `$modhead $idf2_all SPEC001` + set idf2_1 = $tmp_buf[3] + + # Combine BPM files + set bpm1_all = DN_${rn}000$det${om}fbpm.fit + set bpm2_all = DN_${rn}000$det2${om}fbpm.fit + + if (!(-e $bpm1_all)) then + echo "Combine all BPM (from IDF): $bpm1_all ..." + bpm_combine $bpm1_all $idf1_all # Create combined BPM file [dn] for $seg + endif + + if (!(-e $bpm2_all)) then + echo "Combine all BPM (from IDF): $bpm2_all ..." + bpm_combine $bpm2_all $idf2_all # Idem for $seg2 + endif + + # Extract [Day + Night] spectra + set s = DN_${rn}000${seg}fcal.fit + set xxx = DN_${rn}xxx${seg}fcal.fit + if (!(-e $xxx)) cf_extract_spectra -r DN_${rn}xxx $idf1_all # Avoid overwrite LiF | SiC + echo $xxx > tmp_combine.lis + $cf_combine tmp_combine.lis $s -k # Does not combine, just update keywords + $modhead "${s}[0]" NSPEC $n_comb1 + $modhead "${s}[0]" SPEC001 $idf1_1 + $modhead "${s}[1]" COMBMETH BACKGRND + echo $s >> tmp_seg_dn.lis + + set s = DN_${rn}000${seg2}fcal.fit + set xxx = DN_${rn}xxx${seg2}fcal.fit + if (!(-e $xxx)) cf_extract_spectra -r DN_${rn}xxx $idf2_all # Avoid overwrite LiF | SiC + echo $xxx > tmp_combine.lis + $cf_combine tmp_combine.lis $s -k # Does not combine, just update keywords + $modhead "${s}[0]" NSPEC $n_comb2 + $modhead "${s}[0]" SPEC001 $idf2_1 + $modhead "${s}[1]" COMBMETH BACKGRND + echo $s >> tmp_seg_dn.lis + + set n_night = `cat tmp_all_night_exp.lis | wc -l` + if ($om == ttag && $n_night > 0) then # Create and combine night only files + + echo "*** Creating night only files ***" + set exp_nums = `awk '{print $1}' tmp_all_night_exp.lis` + $rm tmp_bpm1.lis tmp_bpm2.lis + + foreach exp ($exp_nums) + + # Create bpm night only files (if they do not exist yet) + set bno1 = NO_$rn$exp$det${om}fbpm.fit + set bno2 = NO_$rn$exp$det2${om}fbpm.fit + + set idf_file = $rn$exp$det${om}fidf.fit + if (!(-e $bno1)) then + echo "Creating BPM: $bno1 ..." + cf_bad_pixels -n $bno1 $idf_file + endif + if (-e $bno1) echo $bno1 >> tmp_bpm1.lis # If valid, add in $seg list + + set idf_file = $rn$exp$det2${om}fidf.fit + if (!(-e $bno2)) then + echo "Creating BPM: $bno2 ..." + cf_bad_pixels -n $bno2 $idf_file + endif + if (-e $bno2) echo $bno2 >> tmp_bpm2.lis # If valid, add in $seg2 list + + end + + + # Combine BPM for $seg and extract spectra + + set bpm1_all = NO_${rn}000$det${om}fbpm.fit + set n_bpm = `cat tmp_bpm1.lis | wc -l` + echo "Number of valid BPM files: $n_bpm" + + if ($n_bpm > 0) then + + echo $n_bpm > tmp_bpm.lis + cat tmp_bpm1.lis >> tmp_bpm.lis + + if (!(-e $bpm1_all)) then + echo "Combine all BPM (from list): $bpm1_all ..." + bpm_combine $bpm1_all tmp_bpm.lis # Create combined BPM file [no] for $seg + endif + $rm tmp_bpm.lis + + endif + + # Extract [Night only] spectra. The existence of $bpm1_all is not required + set s = NO_${rn}000${seg}fcal.fit + set xxx = NO_${rn}xxx${seg}fcal.fit + if (!(-e $xxx)) cf_extract_spectra -n $bpm1_all -r NO_${rn}xxx $idf1_all # Avoid overwrite LiF | SiC + echo $xxx > tmp_combine.lis + $cf_combine tmp_combine.lis $s -k # Does not combine, just update keywords + $modhead "${s}[0]" NSPEC $n_comb1 + $modhead "${s}[0]" SPEC001 $idf1_1 + $modhead "${s}[1]" COMBMETH BACKGRND + echo $s >> tmp_seg_no.lis + + + # Combine BPM for $seg2 and extract spectra + + set bpm2_all = NO_${rn}000$det2${om}fbpm.fit + set n_bpm = `cat tmp_bpm2.lis | wc -l` + echo "Number of valid BPM files: $n_bpm" + + if ($n_bpm > 0) then + + echo $n_bpm > tmp_bpm.lis + cat tmp_bpm2.lis >> tmp_bpm.lis + + if (!(-e $bpm2_all)) then + echo "Combine all BPM (from list): $bpm2_all ..." + bpm_combine $bpm2_all tmp_bpm.lis # Create combined BPM file [no] for $seg2 + endif + $rm tmp_bpm.lis + + endif + + # Extract [Night only] spectra. The existence of $bpm2_all is not required + set s = NO_${rn}000${seg2}fcal.fit + set xxx = NO_${rn}xxx${seg2}fcal.fit + if (!(-e $xxx)) cf_extract_spectra -n $bpm2_all -r NO_${rn}xxx $idf2_all # Avoid overwrite LiF | SiC + echo $xxx > tmp_combine.lis + $cf_combine tmp_combine.lis $s -k # Does not combine, just update keywords + $modhead "${s}[0]" NSPEC $n_comb2 + $modhead "${s}[0]" SPEC001 $idf2_1 + $modhead "${s}[1]" COMBMETH BACKGRND + echo $s >> tmp_seg_no.lis + + endif + endif + endif + end + + $rm tmp_xcorr.res tmp_bpm1.lis tmp_bpm2.lis tmp_combine.lis + $rm tmp_all_night_exp.lis tmp_good_exp.lis tmp_exp.lis tmp_night_exp.lis + + end + + # Pack the 8 [detector][channel] pairs together ([dn] and [no] for ttag) + if (-e tmp_seg_dn.lis) then + + set fcal_all = ${rn}00000all$res${om}fcal.fit # Final output name + $rm $fcal_all # Clean (safe) + set n_segs = `cat tmp_seg_dn.lis | wc -l` + + if (!($n_segs == 8)) then + + @ mseg = 8 - $n_segs + echo "ERROR: $mseg (day + night) segments are missing" + $rm tmp_seg_dn.lis + goto crash + + else + + $cf_pack tmp_seg_dn.lis $fcal_all + $rm tmp_seg_dn.lis + + # Plot figures + echo ".compile '$cf_obsplot'" > tmp_idl_batch + echo "cf_obsplot, '$rn'" >> tmp_idl_batch + echo "exit" >> tmp_idl_batch + idl tmp_idl_batch + $rm tmp_idl_batch + + # Create National Virtual Observatory file + set nvo_file = ${rn}00000nvo$res${om}fcal.fit + $rm $nvo_file # Clean (safe) + $cf_nvo $fcal_all $nvo_file # Create file + + if (-e tmp_seg_no.lis) then + + set fcal_all = ${rn}00000ano$res${om}fcal.fit # Final output name + $rm $fcal_all # Clean (safe) + set n_segs = `cat tmp_seg_no.lis | wc -l` + + if (!($n_segs == 8)) then + + @ mseg = 8 - $n_segs + echo "ERROR: $mseg (night only) segments are missing" + $rm tmp_seg_no.lis + goto crash + + else + + $cf_pack tmp_seg_no.lis $fcal_all + $rm tmp_seg_no.lis + + endif + + endif + endif + endif + end +end + +# Clean [dn] and [no] files. Just keep: all, (ano) and nvo +$rm DN_${rn}*.fit NO_${rn}*.fit +exit(0) + + +crash: # Procedure when script crashes + +# Clean directory +$rm tmp_xcorr.res tmp_bpm1.lis tmp_bpm2.lis tmp_combine.lis tmp_night_exp.lis +$rm tmp_all_night_exp.lis tmp_good_exp.lis tmp_exp.lis tmp_seg_dn.lis tmp_seg_no.lis +$rm DN_*.fit NO_*.fit + +# Return 1 +exit(1) diff --git a/scripts/cf_make_all_obs.csh b/scripts/cf_make_all_obs.csh new file mode 100755 index 0000000..2a97247 --- /dev/null +++ b/scripts/cf_make_all_obs.csh @@ -0,0 +1,555 @@ +#!/usr/local/bin/tcsh -f + +#****************************************************************************** +#* Johns Hopkins University +#* Center For Astrophysical Sciences +#* FUSE +#****************************************************************************** +#* +#* Synopsis: cf_make_all_obs.csh association_file +#* +#* Description: Creates 3 files from Calfuse output (properly run): +#* +#* 1) An "all" file containing 1 extension per detector (= 8). +#* Each extension contains a combined spectrum from the set +#* of exposures, using "Xcorr" or "Background" method. +#* 2) In the case of TTAG data, creates an "ano" file. Same as +#* the "all" file but considering "night only" exposure time. +#* 3) A National Virtual Observatory "nvo" file. One extension +#* containing wavelengths that span the whole FUSE range. +#* +#* The Xcorr method consists of co-adding spectra, the latter +#* being corrected for a possible shift. The Background method +#* consists of combining all the IDF files. +#* +#* The Xcorr test is performed on 4 (detector, channel) pairs, the +#* method of other pairs are given by them: +#* LiF 1a -> Lif 1b +#* LiF 2b -> LiF 2a +#* SiC 1a -> Sic 1b +#* Sic 2b -> Sic 2a +#* In the script, the left segments are referred as to $seg (or +#* $det) and the right segments are referred as to $seg2 (or +#* $det2). +#* +#* When an expected data set is missing, the script stops, cleans +#* the directory, and returns 1. +#* +#* History: 04/15/05 1.0 tc First release +#* 08/22/05 1.1 wvd Argument is name of association file. +#* 10/20/05 1.2 wvd Use idl_obsplot.pl to call cf_obsplot. +#* 10/25/05 1.3 wvd Add option to delete BPM or IDF files. +#* 03/21/06 1.4 wvd If there's only one exposure, always +#* follow the cross-correlation path. +#* Don't check the number of night-only +#* spectra before calling cf_pack. +#* 03/28/06 1.5 wvd If there's no good time in any exposure, +#* follow the cross-correlation path. +#* 04/27/06 1.6 wvd Be smarter when discarding 000 files. +#* Always use cross-corr for HIST data. +#* 05/23/06 1.7 wvd Move -k to proper spot after cf_combine. +#* 06/02/06 1.8 wvd If OBJCLASS = 7 (Sky Background) +#* always combine IDF files. +#* 06/22/06 1.9 wvd Call idf_combine with -z flag. +#* 05/24/07 1.10 bot If only 900+ spectra are available, +#* use them. +#* 04/04/08 1.11 bot Ignore EXP_STAT in cf_combine for HIST +#* data. +#* 07/25/08 1.12 wvd Ignore EXP_STAT in cf_combine and +#* idf_combine for BR-EARTH observations +#* (S100, M106, and 900+ exposures). +#* 08/08/08 1.13 wvd Don't ignore EXP_STAT for 900+ exposures. +#* 08/15/08 1.14 wvd Call cf_make_900_obs.csh +#* to make quick-look airglow plot. +#* +#*****************************************************************************/ + +# Delete files after processing? (Default is no.) +#set DELETE_IDF # Delete intermediate data files +#set DELETE_BPM # Delete bad-pixel map files + +# Set program path +set rm = "/bin/rm -f" + +set cf_xcorr = cf_xcorr +set cf_combine = cf_combine +set cf_pack = cf_pack +set cf_nvo = cf_nvo +set idl_obsplot = idl_obsplot.pl +set modhead = modhead + +#set cf_xcorr = /home/vela/civeit/Work/CalFuse/Xcorr/New/cf_xcorr +#set cf_combine = /home/vela/civeit/Work/CalFuse/Shiftexp/cf_combine +#set cf_pack = /home/vela/civeit/Work/CalFuse/Pack/cf_pack +#set cf_nvo = /home/vela/civeit/Work/CalFuse/Nvo/cf_nvo +#set modhead = /home/vela/civeit/local/bin/modhead + +#set cf_obsplot = /data1/fuse/calfuse/v3.1/idl/cf_obsplot.pro + +# Init var list +set detector = (1a 2b) +set channel = (lif sic) +set resolution = (2 3 4) +set obsmod = (hist ttag) + +# Determine the root name and the program ID +set asnf = $1 +set rn = ${asnf:s/000asnf.fit//} +set pid = `echo $rn | awk '{print substr($1, 1, 4)}'` + +# Determine the object class +set tmp_file = `ls ${rn}*fcal.fit | awk '{if (NR == 1) print}'` +set tmp_buf = `$modhead $tmp_file OBJCLASS` +set objclass = $tmp_buf[2] + +# Clean tmp files that the script will create (safe) +$rm tmp_xcorr.res tmp_bpm1.lis tmp_bpm2.lis tmp_combine.lis tmp_night_exp.lis +$rm tmp_all_night_exp.lis tmp_good_exp.lis tmp_exp.lis tmp_seg_dn.lis tmp_seg_no.lis +$rm DN_${rn}*.fit NO_${rn}*.fit + +foreach om ($obsmod) + foreach res ($resolution) + foreach chan ($channel) + foreach det ($detector) + + set ignore_exp_stat = '' + if ($om == hist) set ignore_exp_stat = -a + if ($pid == S100) set ignore_exp_stat = -a + if ($pid == M106) set ignore_exp_stat = -a + + # Find exposures that match the current segment + set seg = $det$chan$res$om + set readfiles = 0 + ls ${rn}[0-8][0-9][0-9]${seg}fcal.fit |& grep -v 000${seg} > tmp_exp.lis # Reject EXP "9xx" and "000" + + if ($? == 0) then + set readfiles = 1 + else + ls ${rn}9[0-9][0-9]${seg}fcal.fit |& grep -v 000${seg} > tmp_exp.lis # Keep only "9xx" exposures + if ($? == 0) set readfiles = 2 + endif + + if ($readfiles >= 1) then # There are one or more exposures + + echo " " + echo "*** Processing: $seg ***" + # [1a][lif] -> [1b][lif], [2b][lif] -> [2a][lif] etc... + if ($det == 1a) set det2 = 1b + if ($det == 2b) set det2 = 2a + set seg2 = $det2$chan$res$om + + echo "----- cf_xcorr input -----" + cat tmp_exp.lis + echo "----------------------------" + $cf_xcorr tmp_exp.lis tmp_xcorr.res # Compute shift and sigma_shift + echo "----- cf_xcorr results -----" + cat tmp_xcorr.res + echo "----------------------------" + + awk '{if ($5 > 0) print $6, $4, $5}' tmp_xcorr.res > tmp_all_night_exp.lis + awk '{if ($3 >= 0) print $6, $2}' tmp_xcorr.res > tmp_good_exp.lis + awk '{if (($3 >= 0) && ($5 > 0)) print $6, $2, $4, $5}' tmp_xcorr.res > tmp_night_exp.lis + set time_good = `awk 'BEGIN{$t = 0} {if ($3 >= 0) $t = $t + $4} END{print $t}' tmp_xcorr.res` + set time_bad = `awk 'BEGIN{$t = 0} {if ($3 < 0) $t = $t + $4} END{print $t}' tmp_xcorr.res` + echo "Xcorr time: $time_good - Background time: $time_bad" + set n_exp = `cat tmp_xcorr.res | wc -l` + + if (($time_good > 2 * $time_bad && $objclass != 7) || ($time_good == 0 && $time_bad == 0) || $n_exp == 1 || $om == hist) then + + # + # --- Path 1: Optimize resolution --- + # + + echo "Optimize resolution..." + set n_good = `cat tmp_good_exp.lis | wc -l` + + # Extract [Day + Night] spectra + set s = DN_${rn}000${seg}fcal.fit + awk '{print "'$rn'"$1"'$seg'fcal.fit",$2}' tmp_good_exp.lis > tmp_combine.lis # Combine $seg [dn] + # echo "----- Combining Files ----- " + # cat tmp_combine.lis + # echo "Output: " $s + $cf_combine -k $ignore_exp_stat tmp_combine.lis $s + # $modhead "${s}[1]" NUM_EXP $n_good + $modhead "${s}[1]" COMBMETH XCORR + echo $s >> tmp_seg_dn.lis + + set s = DN_${rn}000${seg2}fcal.fit + awk '{print "'$rn'"$1"'$seg2'fcal.fit",$2}' tmp_good_exp.lis > tmp_combine.lis # Combine $seg2 [dn] + # echo "----- Combining Files ----- " + # cat tmp_combine.lis + # echo "Output: " $s + $cf_combine -k $ignore_exp_stat tmp_combine.lis $s + # $modhead "${s}[1]" NUM_EXP $n_good + $modhead "${s}[1]" COMBMETH XCORR + echo $s >> tmp_seg_dn.lis + + set n_night = `cat tmp_night_exp.lis | wc -l` + if ($om == ttag && $n_night > 0) then # Create and combine night only files + + echo "*** Creating night only files ***" + set exp_nums = `awk '{print $1}' tmp_night_exp.lis` + + foreach exp ($exp_nums) + + # Create night-only BPM and FCAL files if they do not already exist. + set bno1 = NO_$rn$exp$det${om}fbpm.fit # Bad-pixel maps + set bno2 = NO_$rn$exp$det2${om}fbpm.fit + set cno1 = NO_$rn$exp${seg}fcal.fit # Extracted spectra + set cno2 = NO_$rn$exp${seg2}fcal.fit + + set etime = `egrep "^$exp" tmp_night_exp.lis | awk '{print $3}'` + set ntime = `egrep "^$exp" tmp_night_exp.lis | awk '{print $4}'` + set ratio = `egrep "^$exp" tmp_night_exp.lis | awk '{printf "%.0f", 0.5+$4/$3*10.}'` + + if (!(-e $cno1)) then + if ($etime == $ntime) then + echo "$cno1 is a symbolic link to $rn$exp${seg}fcal.fit" + ln -s $rn$exp${seg}fcal.fit $cno1 + else + + set idf_file = $rn$exp$det${om}fidf.fit + if (!(-e $bno1)) then + if ($ratio > 9) then + echo "$bno1 is a symbolic link to $rn$exp$det${om}fbpm.fit" + ln -s $rn$exp$det${om}fbpm.fit $bno1 + else + echo "Creating BPM: $bno1 ..." + cf_bad_pixels -n $bno1 $idf_file + endif + endif + + echo "Creating (LiF + SiC) FCAL: $cno1 ..." + cf_extract_spectra -n $bno1 -r NO_$rn$exp $idf_file # Existence of $bno1 is not required + endif + endif + + if (!(-e $cno2)) then + if ($etime == $ntime) then + echo "Using a symbolic link to $cno2" + ln -s $rn$exp${seg2}fcal.fit NO_$rn$exp${seg2}fcal.fit + else + + set idf_file = $rn$exp$det2${om}fidf.fit + if (!(-e $bno2)) then + if ($ratio > 9) then + echo "Using a symbolic link to $bno2" + ln -s $rn$exp$det2${om}fbpm.fit NO_$rn$exp$det2${om}fbpm.fit + else + echo "Creating BPM: $bno2 ..." + cf_bad_pixels -n $bno2 $idf_file + endif + endif + + echo "Creating (LiF + SiC) FCAL: $cno2 ..." + cf_extract_spectra -n $bno2 -r NO_$rn$exp $idf_file # Existence of $bno2 is not required + endif + endif + + end + + # Combine exposures into a single spectrum. + set s = NO_${rn}000${seg}fcal.fit + awk '{print "NO_'$rn'"$1"'$seg'fcal.fit",$2}' tmp_night_exp.lis > tmp_combine.lis # Combine $seg [no] + $cf_combine -k $ignore_exp_stat tmp_combine.lis $s + # $modhead "${s}[1]" NUM_EXP $n_night + $modhead "${s}[0]" DAYNIGHT NIGHT + $modhead "${s}[1]" COMBMETH XCORR + echo $s >> tmp_seg_no.lis + + set s = NO_${rn}000${seg2}fcal.fit + awk '{print "NO_'$rn'"$1"'$seg2'fcal.fit",$2}' tmp_night_exp.lis > tmp_combine.lis # Combine $seg2 [no] + $cf_combine -k $ignore_exp_stat tmp_combine.lis $s + # $modhead "${s}[1]" NUM_EXP $n_night + $modhead "${s}[0]" DAYNIGHT NIGHT + $modhead "${s}[1]" COMBMETH XCORR + echo $s >> tmp_seg_no.lis + + endif + + else + + # + # --- Path 2: Optimize background --- + # + + echo "Optimize background..." + + # Combine IDF files + set idf1_all = DN_${rn}000$det${om}fidf.fit # Same for [dn] and [no] + set idf2_all = DN_${rn}000$det2${om}fidf.fit + + if (!(-e $idf1_all)) then + echo "Creating IDF: $idf1_all ..." + if ($readfiles == 1) then + ls ${rn}[0-8][0-9][0-9]$det${om}fidf.fit |& grep -v 000${det} > tmp_idf.lis # Reject EXP "9xx" and "000" + else + ls ${rn}9[0-9][0-9]$det${om}fidf.fit |& grep -v 000${det} > tmp_idf.lis # Consider only airglow + endif + if ($? == 0) then # IDF files exist + + set idf_lis = `awk '{printf "%s ",$1}' tmp_idf.lis` + # echo "Combining IDF files: " $idf_lis + idf_combine -cz $ignore_exp_stat $idf1_all $idf_lis # Create combined IDF file for $seg + $rm tmp_idf.lis + + else + + echo "ERROR: IDF files are missing" + $rm tmp_idf.lis + goto crash + + endif + endif + + if (!(-e $idf2_all)) then + echo "Creating IDF: $idf2_all ..." + if ($readfiles == 1) then + ls ${rn}[0-8][0-9][0-9]$det2${om}fidf.fit |& grep -v 000${det2} > tmp_idf.lis # Reject EXP "9xx" and "000" + else + ls ${rn}9[0-9][0-9]$det2${om}fidf.fit |& grep -v 000${det2} > tmp_idf.lis # Consider only airglow + endif + if ($? == 0) then # IDF files exist + + set idf_lis = `awk '{printf "%s ",$1}' tmp_idf.lis` + # echo "Combining IDF files: " $idf_lis + idf_combine -cz $ignore_exp_stat $idf2_all $idf_lis # Create combined IDF file for $seg2 + $rm tmp_idf.lis + + else + + echo "ERROR: IDF files are missing" + $rm tmp_idf.lis + goto crash + + endif + endif + + # Get the number of (valid) combined IDF files + set tmp_buf = `$modhead $idf1_all NSPEC` + set n_comb1 = $tmp_buf[3] + set tmp_buf = `$modhead $idf1_all SPEC001` + set idf1_1 = $tmp_buf[3] + set tmp_buf = `$modhead $idf2_all NSPEC` + set n_comb2 = $tmp_buf[3] + set tmp_buf = `$modhead $idf2_all SPEC001` + set idf2_1 = $tmp_buf[3] + + # Combine BPM files + set bpm1_all = DN_${rn}000$det${om}fbpm.fit + set bpm2_all = DN_${rn}000$det2${om}fbpm.fit + + if (!(-e $bpm1_all)) then + echo "Combine all BPM (from IDF): $bpm1_all ..." + bpm_combine $bpm1_all $idf1_all # Create combined BPM file [dn] for $seg + endif + + if (!(-e $bpm2_all)) then + echo "Combine all BPM (from IDF): $bpm2_all ..." + bpm_combine $bpm2_all $idf2_all # Idem for $seg2 + endif + + # Extract [Day + Night] spectra + set s = DN_${rn}000${seg}fcal.fit + set xxx = DN_${rn}xxx${seg}fcal.fit + if (!(-e $xxx)) cf_extract_spectra -r DN_${rn}xxx $idf1_all # Avoid overwrite LiF | SiC + echo $xxx > tmp_combine.lis + $cf_combine -k $ignore_exp_stat tmp_combine.lis $s + $modhead "${s}[0]" NSPEC $n_comb1 + $modhead "${s}[0]" SPEC001 $idf1_1 + $modhead "${s}[1]" COMBMETH BACKGRND + echo $s >> tmp_seg_dn.lis + + set s = DN_${rn}000${seg2}fcal.fit + set xxx = DN_${rn}xxx${seg2}fcal.fit + if (!(-e $xxx)) cf_extract_spectra -r DN_${rn}xxx $idf2_all # Avoid overwrite LiF | SiC + echo $xxx > tmp_combine.lis + $cf_combine -k $ignore_exp_stat tmp_combine.lis $s + $modhead "${s}[0]" NSPEC $n_comb2 + $modhead "${s}[0]" SPEC001 $idf2_1 + $modhead "${s}[1]" COMBMETH BACKGRND + echo $s >> tmp_seg_dn.lis + + set n_night = `cat tmp_all_night_exp.lis | wc -l` + if ($om == ttag && $n_night > 0) then # Create and combine night only files + + echo "*** Creating night only files ***" + set exp_nums = `awk '{print $1}' tmp_all_night_exp.lis` + $rm tmp_bpm1.lis tmp_bpm2.lis + + foreach exp ($exp_nums) + + # Create bpm night only files (if they do not exist yet) + set bno1 = NO_$rn$exp$det${om}fbpm.fit + set bno2 = NO_$rn$exp$det2${om}fbpm.fit + + set idf_file = $rn$exp$det${om}fidf.fit + if (!(-e $bno1)) then + echo "Creating BPM: $bno1 ..." + cf_bad_pixels -n $bno1 $idf_file + endif + if (-e $bno1) echo $bno1 >> tmp_bpm1.lis # If valid, add in $seg list + + set idf_file = $rn$exp$det2${om}fidf.fit + if (!(-e $bno2)) then + echo "Creating BPM: $bno2 ..." + cf_bad_pixels -n $bno2 $idf_file + endif + if (-e $bno2) echo $bno2 >> tmp_bpm2.lis # If valid, add in $seg2 list + + end + + + # Combine BPM for $seg and extract spectra + + set bpm1_all = NO_${rn}000$det${om}fbpm.fit + set n_bpm = `cat tmp_bpm1.lis | wc -l` + echo "Number of valid BPM files: $n_bpm" + + if ($n_bpm > 0) then + + echo $n_bpm > tmp_bpm.lis + cat tmp_bpm1.lis >> tmp_bpm.lis + + if (!(-e $bpm1_all)) then + echo "Combine all BPM (from list): $bpm1_all ..." + bpm_combine $bpm1_all tmp_bpm.lis # Create combined BPM file [no] for $seg + endif + $rm tmp_bpm.lis + + endif + + # Extract [Night only] spectra. The existence of $bpm1_all is not required + set s = NO_${rn}000${seg}fcal.fit + set xxx = NO_${rn}xxx${seg}fcal.fit + if (!(-e $xxx)) cf_extract_spectra -n $bpm1_all -r NO_${rn}xxx $idf1_all # Avoid overwrite LiF | SiC + echo $xxx > tmp_combine.lis + $cf_combine -k $ignore_exp_stat tmp_combine.lis $s + $modhead "${s}[0]" NSPEC $n_comb1 + $modhead "${s}[0]" SPEC001 $idf1_1 + $modhead "${s}[1]" COMBMETH BACKGRND + echo $s >> tmp_seg_no.lis + + + # Combine BPM for $seg2 and extract spectra + + set bpm2_all = NO_${rn}000$det2${om}fbpm.fit + set n_bpm = `cat tmp_bpm2.lis | wc -l` + echo "Number of valid BPM files: $n_bpm" + + if ($n_bpm > 0) then + + echo $n_bpm > tmp_bpm.lis + cat tmp_bpm2.lis >> tmp_bpm.lis + + if (!(-e $bpm2_all)) then + echo "Combine all BPM (from list): $bpm2_all ..." + bpm_combine $bpm2_all tmp_bpm.lis # Create combined BPM file [no] for $seg2 + endif + $rm tmp_bpm.lis + + endif + + # Extract [Night only] spectra. The existence of $bpm2_all is not required + set s = NO_${rn}000${seg2}fcal.fit + set xxx = NO_${rn}xxx${seg2}fcal.fit + if (!(-e $xxx)) cf_extract_spectra -n $bpm2_all -r NO_${rn}xxx $idf2_all # Avoid overwrite LiF | SiC + echo $xxx > tmp_combine.lis + $cf_combine -k $ignore_exp_stat tmp_combine.lis $s + $modhead "${s}[0]" NSPEC $n_comb2 + $modhead "${s}[0]" SPEC001 $idf2_1 + $modhead "${s}[1]" COMBMETH BACKGRND + echo $s >> tmp_seg_no.lis + + endif + endif + endif + end + + $rm tmp_xcorr.res tmp_bpm1.lis tmp_bpm2.lis tmp_combine.lis + $rm tmp_all_night_exp.lis tmp_good_exp.lis tmp_exp.lis tmp_night_exp.lis + + end + + # Pack the 8 [detector][channel] pairs together ([dn] and [no] for ttag) + if (-e tmp_seg_dn.lis) then + + set fcal_all = ${rn}00000all$res${om}fcal.fit # Final output name + $rm $fcal_all # Clean (safe) + set n_segs = `cat tmp_seg_dn.lis | wc -l` + + if (!($n_segs == 8)) then + + @ mseg = 8 - $n_segs + echo "ERROR: $mseg (day + night) segments are missing" + $rm tmp_seg_dn.lis + goto crash + + else + + $cf_pack tmp_seg_dn.lis $fcal_all + $rm tmp_seg_dn.lis + + # Plot figures + $idl_obsplot {$rn} + + # Create National Virtual Observatory file + set nvo_file = ${rn}00000nvo$res${om}fcal.fit + $rm $nvo_file # Clean (safe) + $cf_nvo $fcal_all $nvo_file # Create file + + if (-e tmp_seg_no.lis) then + + set fcal_all = ${rn}00000ano$res${om}fcal.fit # Final output name + $rm $fcal_all # Clean (safe) + set n_segs = `cat tmp_seg_no.lis | wc -l` + + # if (!($n_segs == 8)) then + # + # @ mseg = 8 - $n_segs + # echo "ERROR: $mseg (night only) segments are missing" + # $rm tmp_seg_no.lis + # # goto crash + # + # else + + $cf_pack tmp_seg_no.lis $fcal_all + $rm tmp_seg_no.lis + + # endif + + endif + endif + endif + end +end + +# Clean [dn] and [no] files. Just keep all, (ano) and nvo +$rm DN_${rn}*.fit NO_${rn}*.fit + +# Delete IDF files +if $?DELETE_IDF then + echo "NOTE: Deleting intermediate data files." + $rm ${rn}*idf.fit +endif + +# Delete bad-pixel-map (bpm) files +if $?DELETE_BPM then + echo "NOTE: Deleting bad pixel map (bpm) files." + $rm ${rn}*bpm.fit +endif + +# Call routine to make quick-look airglow plot. +cf_make_900_obs.csh $1 + +exit(0) + +crash: # Procedure when script crashes + +# Clean directory +$rm tmp_xcorr.res tmp_bpm1.lis tmp_bpm2.lis tmp_combine.lis tmp_night_exp.lis +$rm tmp_all_night_exp.lis tmp_good_exp.lis tmp_exp.lis tmp_seg_dn.lis tmp_seg_no.lis +$rm DN_*.fit NO_*.fit + +# Return 1 +exit(1) diff --git a/scripts/cfsetup.csh.in b/scripts/cfsetup.csh.in new file mode 100644 index 0000000..8951b36 --- /dev/null +++ b/scripts/cfsetup.csh.in @@ -0,0 +1,9 @@ +# To execute, type "source cfsetup.csh" +# +set CF_DIR="@PREFIX@" +set CF_VERSION="@VERSION@" +setenv PATH "@PREFIX@/bin:${PATH}" +setenv CF_CALDIR "@DATADIR@/calfiles" +setenv CF_PARMDIR "@DATADIR@/parmfiles" +setenv CF_IDLDIR "@DATADIR@/idl" + diff --git a/scripts/cfsetup.sh.in b/scripts/cfsetup.sh.in new file mode 100644 index 0000000..bdc85d4 --- /dev/null +++ b/scripts/cfsetup.sh.in @@ -0,0 +1,10 @@ +# To execute, type "source cfsetup.sh" +# +CF_DIR="@PREFIX@" +CF_VERSION="@VERSION@" +export PATH="${CF_DIR}/bin:${PATH}" +export CF_CALDIR="${CF_DIR}/calfiles" +export CF_PARMDIR="${CF_DIR}/parmfiles" +export CF_IDLDIR="${CF_DIR}/idl" +export CF_HISTDIR=`pwd` + diff --git a/scripts/idl_obsplot.pl b/scripts/idl_obsplot.pl new file mode 100755 index 0000000..1954936 --- /dev/null +++ b/scripts/idl_obsplot.pl @@ -0,0 +1,48 @@ +#!/usr/bin/env perl +use FileHandle; + +# ****************************************************** +# idlplot_corr.pl +# +# This Perl module will run the idl script "cf_obsplot.pro" +# +# Author: Van Dixon +# +# History: Written July 3, 2001 +# +# 10/20/05 wvd Add call to .run cf_obsplot.pro +# 11/21/06 wvd Add process ID ($$) to name of +# batch file. +# 08/08/08 wvd Add airglow argument for 900+ +# files. +# +# ****************************************************** + +if (@ARGV == 0) { + print "You must enter the rootname of the observation.\n"; + print "Exiting.\n"; + + } else { + + $batch_filename = $ARGV[0] . $$."_idl.bat"; + + # Open the output batch file. + open (BAT_OUTFILE, ">$batch_filename") || die "Cannot open $batch_filename"; + print BAT_OUTFILE "!path='$ENV{CF_IDLDIR}:'+!path\n"; + print BAT_OUTFILE ".run cf_obsplot.pro\n"; + if (@ARGV == 2) { + print BAT_OUTFILE "cf_obsplot,'" . $ARGV[0] . "', airglow=1\n"; + } else { + print BAT_OUTFILE "cf_obsplot,'" . $ARGV[0] . "'\n"; + } + print BAT_OUTFILE "exit\n"; + + close (BAT_OUTFILE); + + system("idl $batch_filename > /dev/null"); + + system("rm $batch_filename"); + + } + +### end of Perl script diff --git a/scripts/idlplot_rate.pl b/scripts/idlplot_rate.pl new file mode 100755 index 0000000..9e33bed --- /dev/null +++ b/scripts/idlplot_rate.pl @@ -0,0 +1,48 @@ +#!/usr/bin/env perl +use FileHandle; + +# *************************************************** +# add_tle.pl +# +# This Perl module will read in the latest five orbital elements +# from the file five.tle (which was created by get_tle.pl) and +# add any new orbital elements to the file FUSE.TLE. The file +# FUSE.TLE is in descending order (i.e. the most recent elements +# are first). In order to prepend the new TLE onto the old list +# I found it was easiest to store everything in a temporary file +# TEMP.TLE and rewrite FUSE.TLE. +# +# Author: Ed Murphy +# +# History: Written July 27, 1999 +# 11/21/06 wvd Add process ID ($$) to name of +# batch file. +# +# *************************************************** + +# Define the file names. old_maintle_filename is not actually opened, +# but is used in a system call at the end of the program. + +if (@ARGV == 0) { + print "You must enter the rootname of the observation.\n"; + print "Exiting.\n"; + + } else { + + $batch_filename = $ARGV[0] . $$."_idl.bat"; + + # Open the output batch file. + open (BAT_OUTFILE, ">$batch_filename") || die "Cannot open $batch_filename"; + print BAT_OUTFILE "!path='$ENV{CF_IDLDIR}:'+!path\n"; + print BAT_OUTFILE "cf_plot_rate3,'" . $ARGV[0] . "'\n"; + print BAT_OUTFILE "exit\n"; + + close (BAT_OUTFILE); + + system("idl $batch_filename > /dev/null"); + + system("rm $batch_filename"); + + } + +### end of Perl script diff --git a/scripts/idlplot_spex.pl b/scripts/idlplot_spex.pl new file mode 100755 index 0000000..701d2f7 --- /dev/null +++ b/scripts/idlplot_spex.pl @@ -0,0 +1,48 @@ +#!/usr/bin/env perl +use FileHandle; + +# *************************************************** +# add_tle.pl +# +# This Perl module will read in the latest five orbital elements +# from the file five.tle (which was created by get_tle.pl) and +# add any new orbital elements to the file FUSE.TLE. The file +# FUSE.TLE is in descending order (i.e. the most recent elements +# are first). In order to prepend the new TLE onto the old list +# I found it was easiest to store everything in a temporary file +# TEMP.TLE and rewrite FUSE.TLE. +# +# Author: Ed Murphy +# +# History: Written July 27, 1999 +# 11/21/06 wvd Add process ID ($$) to name of +# batch file. +# +# *************************************************** + +# Define the file names. old_maintle_filename is not actually opened, +# but is used in a system call at the end of the program. + +if (@ARGV == 0) { + print "You must enter the rootname of the observation.\n"; + print "Exiting.\n"; + + } else { + + $batch_filename = $ARGV[0] . $$."_idl.bat"; + + # Open the output batch file. + open (BAT_OUTFILE, ">$batch_filename") || die "Cannot open $batch_filename"; + print BAT_OUTFILE "!path='$ENV{CF_IDLDIR}:'+!path\n"; + print BAT_OUTFILE "cf_plot_extract3,'" . $ARGV[0] . "'\n"; + print BAT_OUTFILE "exit\n"; + + close (BAT_OUTFILE); + + system("idl $batch_filename > /dev/null"); + + system("rm $batch_filename"); + + } + +### end of Perl script diff --git a/scripts/listhead b/scripts/listhead Binary files differnew file mode 100755 index 0000000..390f00e --- /dev/null +++ b/scripts/listhead diff --git a/scripts/listtra b/scripts/listtra Binary files differnew file mode 100755 index 0000000..4c23921 --- /dev/null +++ b/scripts/listtra diff --git a/src/include/calfitsio.h b/src/include/calfitsio.h new file mode 100644 index 0000000..faa6505 --- /dev/null +++ b/src/include/calfitsio.h @@ -0,0 +1,157 @@ +/***************************************************************************** + * Johns Hopkins University + * Center For Astrophysical Sciences + * FUSE + ***************************************************************************** + * + * Description: Wrappers for cfitsio routines which includes error checking. + * + * History: 04/14/99 peb Finished work on subset of routines + * from cfitsio v2.031. + * 04/14/99 barrett Delete calfuse.h from file + * 04/15/99 barrett Added FITS_get_rowsize + * 04/16/99 barrett Added FITS_get_hdu_num + * 04/20/99 barrett Added FITS_insert_key_[str, log, lng, + * fixflt, flt, fixdbl, dbl, fixcmp, + * cmp, fixdblcmp, dblcmp] + * + ****************************************************************************/ + +#ifndef FITSIO_H +#define FITSIO_H + +#include "fitsio.h" + +int FITS_open_file(fitsfile **fptr, const char *filename, int iomode, + int *status); +int FITS_reopen_file(fitsfile *openfptr, fitsfile **newfptr, int *status); +int FITS_create_file(fitsfile **fptr, const char *filename, int *status); +int FITS_flush_file(fitsfile *fptr, int *status); +int FITS_close_file(fitsfile *fptr, int *status); +int FITS_delete_file(fitsfile *fptr, int *status); +int FITS_file_name(fitsfile *fptr, char *filename, int *status); +int FITS_file_mode(fitsfile *fptr, int *filemode, int *status); +int FITS_write_record(fitsfile *fptr, const char *card, int *status); +int FITS_write_key(fitsfile *fptr, int datatype, char *keyname, void *value, + char *comm, int *status); +int FITS_write_comment(fitsfile *fptr, const char *comm, int *status); +int FITS_write_history(fitsfile *fptr, const char *history, int *status); +int FITS_write_date(fitsfile *fptr, int *status); +int FITS_copy_key(fitsfile *infptr,fitsfile *outfptr,int incol,int outcol, + char *rootname, int *status); +int FITS_write_imghdr(fitsfile *fptr, int bitpix, int naxis, long naxes[], + int *status); +int FITS_write_grphdr(fitsfile *fptr, int simple, int bitpix, int naxis, + long naxes[], long pcount, long gcount, int extend, + int *status); +int FITS_write_btblhdr(fitsfile *fptr, long naxis2, int tfields, char **ttype, + char **tform, char **tunit, char *extname, long pcount, + int *status); +int FITS_get_hdrpos(fitsfile *fptr, int *nexist, int *position, int *status); +int FITS_read_record(fitsfile *fptr, int nrec, char *card, int *status); +int FITS_read_card(fitsfile *fptr, char *keyname, char *card, int *status); +int FITS_read_key(fitsfile *fptr, int datatype, char *keyname, void *value, + char *comm, int *status); +int FITS_read_imghdr(fitsfile *fptr, int maxdim, int *simple, int *bitpix, + int *naxis, long naxes[], long *pcount, long *gcount, + int *extend, int *status); +int FITS_read_btblhdr(fitsfile *fptr, int maxfield, long *naxis2, int *tfields, + char **ttype, char **tform, char **tunit, char *extname, + long *pcount, int *status); +int FITS_update_card(fitsfile *fptr, char *keyname, char *card, int *status); +int FITS_update_key(fitsfile *fptr, int datatype, char *keyname, void *value, + char *comm, int *status); +int FITS_modify_record(fitsfile *fptr, int nkey, char *card, int *status); +int FITS_modify_card(fitsfile *fptr, char *keyname, char *card, int *status); +int FITS_modify_comment(fitsfile *fptr, char *keyname, char *comm, + int *status); +int FITS_insert_record(fitsfile *fptr, int nkey, char *card, int *status); +int FITS_insert_key_str(fitsfile *fptr, char *keyname, char *value, + char *comment, int *status); +int FITS_insert_key_log(fitsfile *fptr, char *keyname, int value, + char *comment, int *status); +int FITS_insert_key_lng(fitsfile *fptr, char *keyname, long value, + char *comment, int *status); +int FITS_insert_key_flt(fitsfile *fptr, char *keyname, float value, + int decimals, char *comment, int *status); +int FITS_insert_key_fixflt(fitsfile *fptr, char *keyname, float value, + int decimals, char *comment, int *status); +int FITS_insert_key_dbl(fitsfile *fptr, char *keyname, double value, + int decimals, char *comment, int *status); +int FITS_insert_key_fixdbl(fitsfile *fptr, char *keyname, double value, + int decimals, char *comment, int *status); +int FITS_insert_key_cmp(fitsfile *fptr, char *keyname, float *value, + int decimals, char *comment, int *status); +int FITS_insert_key_dblcmp(fitsfile *fptr, char *keyname, double *value, + int decimals, char *comment, int *status); +int FITS_insert_key_fixcmp(fitsfile *fptr, char *keyname, float *value, + int decimals, char *comment, int *status); +int FITS_insert_key_fixdblcmp(fitsfile *fptr, char *keyname, double *value, + int decimals, char *comment, int *status); +int FITS_insert_key_null(fitsfile *fptr, char *keyname, char *comment, + int *status); +int FITS_delete_key(fitsfile *fptr, char *keyname, int *status); +int FITS_delete_record(fitsfile *fptr, int keypos, int *status); +int FITS_get_hdu_num(fitsfile *fptr, int *hdunum); +int FITS_get_hdu_type(fitsfile *fptr, int *exttype, int *status); +int FITS_movabs_hdu(fitsfile *fptr, int hdunum, int *exttype, int *status); +int FITS_movrel_hdu(fitsfile *fptr, int hdumov, int *exttype, int *status); +int FITS_movnam_hdu(fitsfile *fptr, int exttype, char *hduname, int hduvers, + int *status); +int FITS_get_num_hdus(fitsfile *fptr, int *nhdu, int *status); +int FITS_create_img(fitsfile *fptr, int bitpix, int naxis, long *naxes, + int *status); +int FITS_create_tbl(fitsfile *fptr, int tbltype, long naxis2, int tfields, + char **ttype, char **tform, char **tunit, char *extname, + int *status); +int FITS_create_hdu(fitsfile *fptr, int *status); +int FITS_insert_img(fitsfile *fptr, int bitpix, int naxis, long *naxes, + int *status); +int FITS_insert_atbl(fitsfile *fptr, long naxis1, long naxis2, int tfields, + char **ttype, long *tbcol, char **tform, char **tunit, + char *extname, int *status); +int FITS_insert_btbl(fitsfile *fptr,long naxis2, int tfields, char **ttype, + char **tform, char **tunit, char *extname, long pcount, + int *status); +int FITS_delete_hdu(fitsfile *fptr, int *hdutype, int *status); +int FITS_copy_hdu(fitsfile *infptr, fitsfile *outfptr, int morekeys, + int *status); +int FITS_copy_header(fitsfile *infptr, fitsfile *outfptr, int *status); +int FITS_copy_data(fitsfile *infptr, fitsfile *outfptr, int *status); +int FITS_get_colnum(fitsfile *fptr, int casesen, char *templt, int *colnum, + int *status); +int FITS_get_colname(fitsfile *fptr, int casesen, char *templt, char *colname, + int *colnum, int *status); +int FITS_get_coltype(fitsfile *fptr, int colnum, int *typecode, long *repeat, + long *width, int *status); +int FITS_get_num_rows(fitsfile *fptr, long *nrows, int *status); +int FITS_get_rowsize(fitsfile *fptr, long *nrows, int *status); +int FITS_get_num_cols(fitsfile *fptr, int *ncols, int *status); +int FITS_get_acolparms(fitsfile *fptr, int colnum, char *ttype, long *tbcol, + char *tunit, char *tform, double *tscal, double *tzero, + char *tnull, char *tdisp, int *status); +int FITS_get_bcolparms(fitsfile *fptr, int colnum, char *ttype, char *tunit, + char *dtype, long *repeat, double *tscal, double *tzero, + long *tnull, char *tdisp, int *status); +int FITS_read_img(fitsfile *fptr, int datatype, long firstelem, long nelem, + void *nulval, void *array, int *anynul, int *status); +int FITS_read_col(fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelem, void *nulval, void *array, + int *anynul, int *status); +int FITS_write_img(fitsfile *fptr, int datatype, long firstelem, long nelem, + void *array, int *status); +int FITS_write_col(fitsfile *fptr, int datatype, int colnum, long firstrow, + long firstelem, long nelem, void *array, int *status); +int FITS_insert_rows(fitsfile *fptr, long firstrow, long nrows, int *status); +int FITS_delete_rows(fitsfile *fptr, long firstrow, long nrows, int *status); +int FITS_delete_rowlist(fitsfile *fptr, long *rownum, long nrows, + int *status); +int FITS_insert_col(fitsfile *fptr, int numcol, char *ttype, char *tform, + int *status); +int FITS_insert_cols(fitsfile *fptr, int firstcol, int ncols, char **ttype, + char **tform, int *status); +int FITS_delete_col(fitsfile *fptr, int numcol, int *status); +int FITS_copy_col(fitsfile *infptr, fitsfile *outfptr, int incol, int outcol, + int create_col, int *status); + +#endif diff --git a/src/include/calfuse.h b/src/include/calfuse.h new file mode 100644 index 0000000..a1ab6e9 --- /dev/null +++ b/src/include/calfuse.h @@ -0,0 +1,536 @@ +/***************************************************************************** + * Johns Hopkins University + * Center For Astrophysical Sciences + * FUSE + ***************************************************************************** + * + * Synopsis: #include "calfuse.h" + * + * Description: Master include file for FUSE calibration pipeline processing + * system. Global shared variables and structures are defined + * here, as well as symbols and default values of parameters. + * + * Arguments: none + * + * Returns: none + * + * History: 11/01/02 1.1 peb Begin work + * 12/10/02 1.3 wvd Continue work + * 12/20/02 1.4 wvd Change flags to unsigned char in + * screening routines. + * 01/14/03 1.5 wvd Change cf_fpa_pos to cf_read_fpa_pos + * 01/17/03 1.6 wvd Added new calibration files + * DIGI_CAL and SPEC_CAL + * Added cf_check_digitizer and DIGI_COR + * 02/05/03 1.7 wvd Added spectral extraction routines + * Interpolate between FLUX_CAL files. + * Define HC + * 02/12/03 1.8 wvd Added convert_to_ergs + * Replace FLUX_CAL with AEFF_CAL + * 02/14/03 1.9 wvd Added FLAT, WGTS and WORM calibration + * file keywords. + * 02/24/03 1.10 wvd Added subroutines of cf_extract + * and char *cf_hist_file(char *); + * 02/28/03 1.12 peb Added function definitions for + * cf_rebin_and_flux_calibrate_backround, + * cf_standard_or_optimal_extraction, + * cf_optimal_extraction, and + * cf_write_extracted_spectrum. + * 03/04/03 1.13 peb Added astig_read_file, + * astig_check_input_image, + * astig_target_aperture + * 03/05/03 1.14 wvd Added cf_target_count_rate + * 03/07/03 1.15 peb Changed cf_error_init, added + * cf_verbose, and made pha, timeflgs, and + * loc_flgs function type consistent. + * 03/11/03 1.16 wvd Changed channel from unsigned char to + * char in a few subroutines. + * 03/18/03 1.17 wvd variable argument list for cf_verbose + * 03/25/03 1.18 peb variable argument list for cf_if_error + * and cf_if_warning + * 03/21/03 1.19 wvd Add flag for photon in pot hole + * 04/01/03 1.21 wvd Delete cf_errmsg; obsolete + * 04/08/03 1.22 wvd Change definition of cf_apply_filters + * 04/09/03 1.23 wvd Add bad-pixel maps to calibration files. + * 04/17/03 1.25 wvd Add final_call to cf_identify_channel + * Add final_call and weight to + * cf_calculate_y_centroid + * 04/18/03 1.26 wvd Add cf_find_spectra + * 04/21/03 1.27 wvd Modify cf_grating_motion, + * cf_mirror_motion, and + * cf_satellite_jitter. + * Define FRAME_TOLERANCE. + * 04/28/03 v1.28 wvd Modified cf_fuv_init not to extrapolate + * the last two calibration files forward. + * 05/10/03 v1.29 wvd Pass locflag to cf_set_photon_flags + * 05/16/03 v1.30 wvd Add cf_make_mask. + * Set PERFORM keywords for HIST data. + * 05/28/03 v1.31 rdr Modified def of cf_optimal_extraction + * and cf_write_extracted_spectrum + * 05/30/03 v1.34 wvd Pass WEIGHTS to cf_set_photon_flags + * 06/09/03 v1.35 rdr Change definition of cf_apply_filters + * 06/11/03 v1.36 wvd Change HV array to type short. + * 06/11/03 v1.37 wvd Pass datatype to cf_read_col and + * cf_write_col. + * 07/16/03 v1.38 wvd Move initialization routines to libcf + * 07/23/03 v1.39 wvd Add HSKP_CAL to list of cal files + * Increment OPUS_VERSION to 2.7 + * 08/01/03 v1.40 wvd Add cf_apply_dead_time to pipeline, + * modify arguments of dead-time routines. + * 08/04/03 v1.41 wvd Convert count-rate arrays to shorts. + * 08/06/03 v1.42 wvd Delete GTI's from cf_satellite_jitter + * 08/21/03 v1.43 wvd Change channel array to unsigned char + * in subroutines of cf_remove_motion + * 08/22/03 v1.44 wvd Add cf_get_extraction_limits. + * 08/22/03 v1.45 wvd Change limits of extraction window + * from type int to type short. + * 08/25/03 v1.46 wvd Add cf_nint, change coltype in + * cf_idf_io routines from string to int + * 08/28/03 v1.47 wvd Modify structure saareg + * 09/10/03 v1.48 wvd Define cf_set_user_gtis + * Modify args of cf_screen_burst + * 09/15/03 v1.49 wvd Add structure top_level_routines + * Delete astig_read_file and + * astig_target_aperture. + * Modify args of cf_identify_channel + * 10/02/03 v1.50 wvd Exchange PHA and GTI flags. + * Change version number to 3.0.2. + * 10/08/03 v1.51 wvd Change counts_out to type long + * 10/26/03 v1.52 wvd Change arguments of cf_find_spectra + * and cf_calculate_y_centroid. + * 10/31/03 v1.53 wvd Change channel to unsigned char + * throughout. + * 11/26/03 v1.54 wvd Change aic_rate and fec_rate to float + * throughout. + * 12/21/03 v1.55 wvd Remove underscore from idf and bpm + * filenames. + * Change version number to 3.0.3. + * 02/09/04 v1.56 wvd Employ new scheme for dead-time + * correction. Add cf_nlong() and + * cf_screen_fifo_overflow. + * Change version number to 3.0.4. + * 02/27/04 v1.57 rdr Change def of cf_thermal_distortion + * 03/02/04 v1.58 wvd Implement WPC array in extraction + * routine. + * Add cf_x2lambda. + * Change version number to 3.0.5. + * 03/16/04 v1.59 wvd Delete WPC array. + * Smooth HIST data in X. + * Comment out cf_astig_farf. + * Change version number to 3.0.6. + * 04/05/04 v1.60 wvd Modify cf_geometric_distort to + * rescale SPECBINY only for HIST data. + * 04/09/04 v1.61 wvd Fix bugs in cf_optimal_extraction. + * Change version number to 3.0.7. + * 04/09/04 v1.62 bjg Define FILL_DATA and LOCATION_FILL + * 04/26/04 v1.63 wvd Replace cf_rebin_and_flux_ + * calibrate_background with + * cf_rebin_background. + * Modify args to cf_optimal_extraction + * and cf_find_spectra. + * 06/02/04 v1.64 wvd Add cf_modify_hist_times. + * Populate the header keywords + * TIME_COR, COMB_COR, and QUIK_COR + * Modify args to cf_calculate_y_centroid, + * cf_find_spectra, cf_satellite_jitter, + * cf_apply_filters, and + * cf_write_extracted_spectrum. + * Modify order of CALIBRATION_STEP_KEYS. + * 08/19/04 v1.65 wvd Add FES definitions and subroutines. + * 10/12/04 v1.66 wvd Change version number to 3.0.8 + * 02/01/05 v1.67 wvd Change version number to 3.1.0 + * Modify args to cf_screen_burst + * 03/02/05 v1.68 wvd Add cf_modify_hist_pha and PHAH_COR. + * Walk correct HIST data. + * Change cf_ttag_bkgd to cf_scale_bkgd + * and pass weights array to it. + * Change cf_get_extraction_limits to + * cf_extraction_limits; it now returns + * X limits of extraction window. + * Add cf_screen_airglow. + * 03/22/05 v1.69 wvd Change TIME_SUNRISE and TIME_SUNSET + * from floats to shorts. + * 04/19/05 v1.70 wvd Change version number to 3.1.1 + * 06/15/05 v1.71 wvd BUG FIX: cf_extract_spectra always + * read the point-source probability + * array from WGTS_CAL file. Now uses + * variable "extended" to determine + * which HDU to read. Modify args to + * cf_rebin_probability_array + * Change version number to 3.1.2 + * Delete QUIK_COR from structure + * CALIBRATION_STEP_KEYS. + * 08/30/05 v1.72 wvd Define MAX_EXPTIME = 55000 + * Delete cf_read_fpa_pos + * Change version number to 3.1.3 + * 09/19/05 v1.73 wvd Reinstall cf_read_fpa_pos, as it is + * needed by ttag_combine. + * 09/30/05 v1.74 wvd Change version number to 3.1.4 + * Pass photon array to + * cf_screen_fifo_overflow. + * 11/22/05 v1.75 wvd Add cf_screen_bad_pixels, + * cf_screen_jitter, and + * cf_get_potholes + * Change version number to 3.1.5 + * 01/24/06 v1.76 wvd Change version number to 3.1.6 + * 02/03/06 v1.77 wvd Change version number to 3.1.7 + * 05/15/06 v1.78 wvd Divide cf_astigmatism_and_dispersion + * into two separate routines. Incorporate + * cf_x2lambda into cf_dispersion. + * Change version number to 3.1.8 + * Delete cf_astig_farf. + * 06/12/06 v1.79 wvd Add pole_ang.c + * Change version number to 3.1.9 + * Add -a to cf_remove_motions + * 11/02/06 v1.80 wvd Add cf_time_xy_distort.c + * Change version number to 3.2.0 + * Add APER_COR to list of cal steps. + * Change cf_screen_fifo_overflow to + * cf_fifo_deadtime. Modify args to + * it, cf_apply_dead_time, and + * cf_target_count_rate. Run + * cf_target_count_rate on HIST data. + * 03/07/07 v1.81 wvd Modify arguments to space_vel. + * 05/18/07 v1.82 wvd Change version number to 3.2.1. + * 09/15/07 v1.83 bot Change version number to 3.2.2. + * 10/16/07 v1.84 bot Added brackets in + * FES_CALIBRATION_STEP_KEYS + * and in CALIBRATION_FILE_KEYS. + * 08/22/08 v1.85 wvd Change version number to 3.2.3. + * Many changes to better handle + * bright-earth observations & + * 900-level airglow exposures. + * + ****************************************************************************/ + +#include "calfitsio.h" + +#define CALFUSE_VERSION "3.2.3" + +#define LARGEMJD 9999999999.0 +#define OPUS_VERSION 2.7 /* Oldest compatible version of OPUS */ +#define PI 3.1415926535897932384626433832795028841971693993751 +#define RADIAN 0.017453292519943295769236907684886127134428718885417 +#define C 299792.458 +#define HC 1.98644746104e-8 /* erg A */ +#define MU 3.986005E5 /* km^3 s^-2 */ +#define RE 6371.00 /* km */ +#define RS 6.960E5 +#define AU 1.495978707E8 +#define FRAME_TOLERANCE 0.004 + +#define FESPIX 266256 /* This is 516*516 */ +#define FILL_DATA 21865 +#define NXMAX 16384 +#define NYMAX 1024 + +#define TEMPORAL_DAY (0x01<<0) +#define TEMPORAL_LIMB (0x01<<1) +#define TEMPORAL_SAA (0x01<<2) +#define TEMPORAL_HV (0x01<<3) +#define TEMPORAL_BRST (0x01<<4) +#define TEMPORAL_OPUS (0x01<<5) +#define TEMPORAL_JITR (0x01<<6) +#define TEMPORAL_USER (0x01<<7) + +#define LOCATION_SHLD (0x01<<0) +#define LOCATION_AIR (0x01<<1) +#define LOCATION_STIML (0x01<<2) +#define LOCATION_STIMR (0x01<<3) +#define LOCATION_PHA (0x01<<4) +#define LOCATION_BADPX (0x01<<5) +#define LOCATION_FILL (0x01<<6) + +#define MAX_EXPTIME 55000 + +struct fes_keyword_tab +{ + char name[9]; + char value[8]; + char proc[18]; +}; + +#define NUM_FES_PROC_STEPS 6 + +#define FES_CALIBRATION_STEP_KEYS { \ + {"INIT_FES\0","PERFORM\0","cf_fes_init\0"},\ + {"MASK_FES\0","PERFORM\0","cf_fes_mask\0"},\ + {"BIAS_FES\0","PERFORM\0","cf_fes_bias\0"},\ + {"FLAT_FES\0","PERFORM\0","cf_fes_flat\0"},\ + {"UNDS_FES\0","PERFORM\0","cf_fes_undistort\0"},\ + {"FLUX_FES\0","PERFORM\0","cf_fes_flux\0"},\ +} + +#define NUM_FES_CAL_KEYS 5 + +#define FES_CALIBRATION_FILE_KEYS { \ + "MASK",1,"FCL","\0","\0","\0",0.0,0.0,LARGEMJD,0,0,0,\ + "BIAS",2,"FCL","\0","\0","\0",0.0,0.0,LARGEMJD,0,0,0,\ + "FFLT",2,"FCL","\0","\0","\0",0.0,0.0,LARGEMJD,0,0,0,\ + "FGEO",1,"FCL","\0","\0","\0",0.0,0.0,LARGEMJD,0,0,0,\ + "FFLX",2,"FCL","\0","\0","\0",0.0,0.0,LARGEMJD,0,0,0\ + } + +typedef struct { + double ra_ap; + double dec_ap; + double limb; +} orbital; + +typedef struct { + long n_points; + float *lat; + float *lon; +} saareg; + +typedef struct { + long ntimes; /* The number of intervals */ + double *start; /* An array of starting times (in seconds) */ + double *stop; /* An array of stoping times (in seconds) */ +} GTI; /* Good Time Intervals */ + +struct keyword_tab +{ + char name[9]; + char hist_value[8]; + char hist_proc[32]; + char ttag_value[8]; + char ttag_proc[32]; +}; + +#define NTOP_LEVEL_ROUTINES 11 + +#define TOP_LEVEL_ROUTINES { \ + "cf_ttag_init", \ + "cf_hist_init", \ + "cf_convert_to_farf", \ + "cf_ttag_countmap", \ + "cf_ttag_gainmap", \ + "cf_remove_motions", \ + "cf_assign_wavelength", \ + "cf_screen_photons", \ + "cf_flux_calibrate", \ + "cf_bad_pixels", \ + "cf_extract_spectra" \ +} + +#define NUM_PROC_STEPS 40 + +#define CALIBRATION_STEP_KEYS { \ + {"INIT_COR", "PERFORM", "cf_hist_init", "PERFORM", "cf_ttag_init"}, \ + {"DIGI_COR", "PERFORM", "cf_check_digitizer", "PERFORM", "cf_check_digitizer"}, \ + {"IDS__COR", "PERFORM", "cf_ids_dead_time", "PERFORM", "cf_ids_dead_time"}, \ + {"ELEC_COR", "PERFORM", "cf_electronics_dead_time", "PERFORM", "cf_electronics_dead_time"}, \ + {"FIFO_COR", "OMIT", "cf_fifo_dead_time", "PERFORM", "cf_fifo_dead_time"}, \ + {"DEAD_COR", "PERFORM", "cf_apply_dead_time", "PERFORM", "cf_apply_dead_time"}, \ + {"THRM_COR", "PERFORM", "cf_thermal_distort", "PERFORM", "cf_thermal_distort"}, \ + {"RATE_COR", "PERFORM", "cf_count_rate_y_distort", "PERFORM", "cf_count_rate_y_distort"}, \ + {"TMXY_COR", "PERFORM", "cf_time_xy_distort", "PERFORM", "cf_time_xy_distort"}, \ + {"GEOM_COR", "PERFORM", "cf_geometric_distort", "PERFORM", "cf_geometric_distort"}, \ + {"PHAH_COR", "PERFORM", "cf_modify_hist_pha", "OMIT", "cf_modify_hist_pha"}, \ + {"PHAX_COR", "PERFORM", "cf_pha_x_distort", "PERFORM", "cf_pha_x_distort"}, \ + {"ACTV_COR", "PERFORM", "cf_active_region", "PERFORM", "cf_active_region"}, \ + {"LIMB_COR", "PERFORM", "cf_screen_limb_angle", "PERFORM", "cf_screen_limb_angle"}, \ + {"SAA__COR", "PERFORM", "cf_screen_saa", "PERFORM", "cf_screen_saa"}, \ + {"VOLT_COR", "PERFORM", "cf_screen_high_voltage", "PERFORM", "cf_screen_high_voltage"}, \ + {"BRST_COR", "OMIT", "cf_screen_burst", "PERFORM", "cf_screen_burst"}, \ + {"APER_COR", "PERFORM", "cf_screen_jitter", "PERFORM", "cf_screen_jitter"}, \ + {"UGTI_COR", "OMIT", "cf_set_user_gtis", "PERFORM", "cf_set_user_gtis"}, \ + {"FLAG_COR", "PERFORM", "cf_set_photon_flags", "PERFORM", "cf_set_photon_flags"}, \ + {"GTI__COR", "PERFORM", "cf_set_good_time_intervals", "PERFORM", "cf_set_good_time_intervals"}, \ + {"TIME_COR", "PERFORM", "cf_modify_hist_times", "OMIT", "cf_modify_hist_times"}, \ + {"AIRG_COR", "PERFORM", "cf_screen_airglow", "PERFORM", "cf_screen_airglow"}, \ + {"BPIX_COR", "PERFORM", "cf_screen_bad_pixels", "PERFORM", "cf_screen_bad_pixels"}, \ + {"PHA__COR", "OMIT", "cf_screen_pulse_height", "PERFORM", "cf_screen_pulse_height"}, \ + {"FIND_COR", "PERFORM", "cf_find_spectra", "PERFORM", "cf_find_spectra"}, \ + {"YMOT_COR", "OMIT", "cf_calculate_ycent_motion", "PERFORM", "cf_calculate_ycent_motion"}, \ + {"GRAT_COR", "PERFORM", "cf_grating_motion", "PERFORM", "cf_grating_motion"}, \ + {"FPA__COR", "PERFORM", "cf_fpa_position", "PERFORM", "cf_fpa_position"}, \ + {"MIRR_COR", "PERFORM", "cf_mirror_motion", "PERFORM", "cf_mirror_motion"}, \ + {"JITR_COR", "OMIT", "cf_satellite_jitter", "PERFORM", "cf_satellite_jitter"}, \ + {"YCNT_COR", "PERFORM", "cf_calculate_y_centroid", "PERFORM", "cf_calculate_y_centroid"}, \ + {"CHID_COR", "PERFORM", "cf_identify_channel", "PERFORM", "cf_identify_channel"}, \ + {"TCRT_COR", "PERFORM", "cf_target_count_rate", "PERFORM", "cf_target_count_rate"}, \ + {"ASTG_COR", "PERFORM", "cf_astigmatism", "PERFORM", "cf_astigmatism"}, \ + {"WAVE_COR", "PERFORM", "cf_dispersion", "PERFORM", "cf_dispersion"}, \ + {"DOPP_COR", "PERFORM", "cf_doppler_and_heliocentric", "PERFORM", "cf_doppler_and_heliocentric"}, \ + {"FLAT_COR", "OMIT", "cf_flat_field", "OMIT", "cf_flat_field"}, \ + {"FLUX_COR", "PERFORM", "cf_convert_to_ergs", "PERFORM", "cf_convert_to_ergs"}, \ + {"COMB_COR", "PERFORM", "cf_coadd", "PERFORM", "cf_coadd"} \ +} + + +struct cal_file_tab +{ + char name[5]; + int numfiles; + char extension[4]; + char filenames[3][19]; + float aftermjd[3]; + int interp[3]; +}; + +#define NUMCALKEYS 28 + +#define CALIBRATION_FILE_KEYS { \ + {"AEFF", 2, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"AIRG", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"ASTG", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"BCHR", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"BKGD", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"CHID", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"DIGI", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"ELEC", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"FLAT", 2, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"GEOM", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"GRAT", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"HSKP", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"JITR", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"MIRR", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"PARM", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"PHAH", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"PHAX", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"QUAL", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"RATE", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"TMXY", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"SAAC", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"SCRN", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"SPEC", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"STIM", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"VOLT", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"WAVE", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"WGTS", 1, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}},\ + {"WORM", 2, "CAL", {"", "", ""}, {0.0, 0.0, LARGEMJD}, {0, 0, 0}} \ +} + +extern int verbose_level; + +void cf_error_init(const char *, const char *, FILE *); +void cf_verbose(int, const char *, ...); +void cf_if_fits_error(int); +void cf_if_warning(char *, ...); +void cf_if_error(char *, ...); +void *cf_malloc(size_t); +void *cf_calloc(size_t, size_t); + +void cf_timestamp(const char *, const char *, char *); +int cf_proc_check(fitsfile *, char *); +int cf_proc_update(fitsfile *, char *, char *); +int cf_fuv_init(fitsfile *); + +char *cf_cal_file(char *); +char *cf_parm_file(char *); +int eclipse(double *, double, double *); +double geod_mag(double, double); +double helio_vel(double, double, double); +double lsrd_vel(double, double); +double lsrk_vel(double, double); +void month_day(int, int, int*, int*); +void read_tle(fitsfile *); +double pole_ang(double *, double *, double, double); +double solar_ang(double, double, double); +int saa(saareg *, double, double); +double space_vel(double *, double, double); +void state_geod(double *, double, double *, double *, double *); +double state_limb(double *, double, double, double, double *,int *); +void cf_velang(fitsfile *, double); +int astig_check_input_image(fitsfile *); + +long cf_read_col(fitsfile *, int, char *, void **); +int cf_write_col(fitsfile *, int, char *, void *, long); +int cf_nint (double); +long cf_nlong (double); + +int cf_fes_proc_check(fitsfile *, char *); +int cf_fes_proc_update(fitsfile *, char *, char *); + +int cf_add_header_keywords(fitsfile *); +long cf_get_times(fitsfile *, double **); +int cf_get_gti(fitsfile *, double **, double **); +int cf_get_geocorona(fitsfile *, short **, short **, short **, short **); +int cf_get_potholes(fitsfile *, float **, float **, float **, float **); +int cf_timeline(fitsfile *); +int cf_set_background_limits(fitsfile *); +long cf_extraction_limits(fitsfile *, int, int, short **, short **, + short*, short*); + +int cf_check_digitizer(fitsfile *); +int cf_ids_dead_time(fitsfile *, long, float *, float *); +int cf_electronics_dead_time(fitsfile *, long, float *, float *); +int cf_fifo_dead_time(fitsfile *, long, float *, long, float *, float *, + float *); +int cf_apply_dead_time(fitsfile *, long, float *, float *, + long, float *, float *, float *); +int cf_thermal_distort(fitsfile *, long, float *, float *, float *, + unsigned char *); +int cf_count_rate_y_distort(fitsfile *, long, float *, float *, + unsigned char *, long, float *, float *); +int cf_time_xy_distort(fitsfile *, long, float *, float *, unsigned char *); +int cf_geometric_distort(fitsfile *, long, float *, float *, + unsigned char *); +int cf_modify_hist_pha(fitsfile *, long, unsigned char *, unsigned char *); +int cf_pha_x_distort(fitsfile *, long, unsigned char *, float *, + unsigned char *); +int cf_active_region(fitsfile *, long, float *, float *, unsigned char *); + +int cf_find_spectra(fitsfile *, long, float *, float *, float *, + unsigned char *, unsigned char *, unsigned char *, int); +int cf_identify_channel(fitsfile *, long, float *, float *, unsigned char *, + unsigned char *, int, int); +int cf_calculate_ycent_motion(fitsfile*, long, float*, float*, + unsigned char*, unsigned char*, long, float*, float*, float*); +int cf_source_aper(fitsfile*, int*); +int cf_grating_motion(fitsfile *, long, float *, float *, float *, + unsigned char *, long, float *, short *); +int cf_fpa_position(fitsfile *, long, float *, unsigned char *); +int cf_read_fpa_pos (fitsfile *, float *, float *); +int cf_mirror_motion(fitsfile *, long, float *, float *, float *, + unsigned char *, long, float *, short *); +int cf_satellite_jitter(fitsfile *, long, float *, float *, float *, + unsigned char *, long, float *, unsigned char *); +int cf_calculate_y_centroid(fitsfile*, long, float*, float*, float*, + unsigned char*, unsigned char*, unsigned char*); +int cf_target_count_rate(fitsfile *, long, float *, float *, unsigned char *, + unsigned char *, long, float *, float *, float *); +int cf_screen_limb_angle(fitsfile *, long, unsigned char *, float *); +int cf_screen_saa(fitsfile *, long, unsigned char *, float *, float *); +int cf_screen_airglow(fitsfile *, long, float *, float *, unsigned char *); +int cf_screen_bad_pixels(fitsfile *, long, float *, float *, unsigned char *); +int cf_screen_burst(fitsfile *, long, float *, float *, float *, + unsigned char *, GTI *, long, float *, unsigned char *, float *, + short *); +int cf_screen_jitter(fitsfile *, long, float *, unsigned char *); +int cf_set_user_gtis(fitsfile *, long, float *, unsigned char *); +int cf_screen_high_voltage(fitsfile *, long, unsigned char *, short *); +int cf_screen_pulse_height(fitsfile *, long, unsigned char *, unsigned char *); +int cf_set_photon_flags(fitsfile *, long, float *, float *, unsigned char *, + unsigned char *, long, float *, unsigned char *); +int cf_set_good_time_intervals(fitsfile *, long, float *, unsigned char *, + GTI *); +int cf_modify_hist_times(fitsfile *, long, float *, GTI *); +int cf_astigmatism(fitsfile *, long, float *, float *, unsigned char *); +int cf_dispersion(fitsfile *, long , float *, unsigned char *, float *); +int cf_doppler_and_heliocentric(fitsfile *, long, float *, unsigned char *, + float *, long, float *, float *); +int cf_convert_to_ergs(fitsfile *, long , float *, float *, + unsigned char *, float *); +int cf_apply_filters(fitsfile *, int, long, unsigned char *, unsigned char *, + long, unsigned char *, long *, long *, long *, long **); +int cf_scale_bkgd(fitsfile *, long, float *, float *, float *, unsigned char *, + unsigned char *, unsigned char *, long, + long *, long, long, int *, int *, int *, int *, int *, float **, + int *, int *, int *, float **); +int cf_make_mask(fitsfile *, int, long, float *, int, int, float **); +int cf_make_wave_array(fitsfile *, int, long *, float **); +int cf_rebin_probability_array(fitsfile *, int, int, long, float *, int *, + float *, float **); +int cf_rebin_background(fitsfile *, int, long, float *, + int, int, int, int, float *, float **); +int cf_standard_or_optimal_extraction(fitsfile *, int *); +int cf_optimal_extraction(fitsfile *, int, int, float *, float *, + unsigned char *, float *, long, long *, float *, + float *, int, float, float *, long, float *, float **, + float **, long **, float **, float **, short **); +int cf_write_extracted_spectrum(fitsfile *, int, int, long, float *, + float *, float *, long *, float *, float *, short *, char *); +char *cf_hist_file(char *); diff --git a/src/include/cfortran.doc b/src/include/cfortran.doc new file mode 100644 index 0000000..6c6f4b3 --- /dev/null +++ b/src/include/cfortran.doc @@ -0,0 +1,2051 @@ +/* cfortran.doc 4.3 */ +/* www-zeus.desy.de/~burow OR anonymous ftp@zebra.desy.de */ +/* Burkhard Burow burow@desy.de 1990 - 1998. */ + + + cfortran.h : Interfacing C or C++ and FORTRAN + +Supports: Alpha and VAX VMS, Alpha OSF, DECstation and VAX Ultrix, IBM RS/6000, + Silicon Graphics, Sun, CRAY, Apollo, HP9000, LynxOS, Convex, Absoft, + f2c, g77, NAG f90, PowerStation Fortran with Visual C++, NEC SX-4, + Portland Group. + +C and C++ are generally equivalent as far as cfortran.h is concerned. +Unless explicitly noted otherwise, mention of C implicitly includes C++. +C++ compilers tested include: + SunOS> CC +p +w # Clean compiles. + IRIX> CC # Clean compiles. + IRIX> CC -fullwarn # Still some warnings to be overcome. + GNU> g++ -Wall # Compiles are clean, other than warnings for unused + # cfortran.h static routines. + +N.B.: The best documentation on interfacing C or C++ and Fortran is in + the chapter named something like 'Interfacing C and Fortran' + to be found in the user's guide of almost every Fortran compiler. + Understanding this information for one or more Fortran compilers + greatly clarifies the aims and actions of cfortran.h. + Such a chapter generally also addresses issues orthogonal to cfortran.h, + for example the order of array indices, the index of the first element, + as well as compiling and linking issues. + + +0 Short Summary of the Syntax Required to Create the Interface +-------------------------------------------------------------- + +e.g. Prototyping a FORTRAN subroutine for C: + +/* PROTOCCALLSFSUBn is optional for C, but mandatory for C++. */ + + PROTOCCALLSFSUB2(SUB_NAME,sub_name,STRING,PINT) +#define SUB_NAME(A,B) CCALLSFSUB2(SUB_NAME,sub_name,STRING,PINT, A,B) + + ^ - - + number of arguments _____| | STRING BYTE PBYTE BYTEV(..)| + / | STRINGV DOUBLE PDOUBLE DOUBLEV(..)| + / | PSTRING FLOAT PFLOAT FLOATV(..)| + types of arguments ____ / | PNSTRING INT PINT INTV(..)| + \ | PPSTRING LOGICAL PLOGICAL LOGICALV(..)| + \ | PSTRINGV LONG PLONG LONGV(..)| + \ | ZTRINGV SHORT PSHORT SHORTV(..)| + | PZTRINGV ROUTINE PVOID SIMPLE | + - - + + +e.g. Prototyping a FORTRAN function for C: +/* PROTOCCALLSFFUNn is mandatory for both C and C++. */ +PROTOCCALLSFFUN1(INT,FUN_NAME,fun_name,STRING) +#define FUN_NAME(A) CCALLSFFUN1(FUN_NAME,fun_name,STRING, A) + +e.g. calling FUN_NAME from C: {int a; a = FUN_NAME("hello");} + + +e.g. Creating a FORTRAN-callable wrapper for + a C function returning void, with a 7 dimensional integer array argument: + [Not supported from C++.] +FCALLSCSUB1(csub_name,CSUB_NAME,csub_name,INTVVVVVVV) + + +e.g. Creating a FORTRAN-callable wrapper for other C functions: +FCALLSCFUN1(STRING,cfun_name,CFUN_NAME,cfun_name,INT) + [ ^-- BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, VOID + are other types returned by functions. ] + + +e.g. COMMON BLOCKs: +FORTRAN: common /fcb/ v,w,x + character *(13) v, w(4), x(3,2) +C: +typedef struct { char v[13],w[4][13],x[2][3][13]; } FCB_DEF; +#define FCB COMMON_BLOCK(FCB,fcb) +COMMON_BLOCK_DEF(FCB_DEF,FCB); +FCB_DEF FCB; /* Define, i.e. allocate memory, in exactly one *.c file. */ + +e.g. accessing FCB in C: printf("%.13s",FCB.v); + + + +I Introduction +-------------- + +cfortran.h is an easy-to-use powerful bridge between C and FORTRAN. +It provides a completely transparent, machine independent interface between +C and FORTRAN routines (= subroutines and/or functions) and global data, +i.e. structures and COMMON blocks. + +The complete cfortran.h package consists of 4 files: the documentation in +cfortran.doc, the engine cfortran.h, examples in cfortest.c and +cfortex.f/or. [cfortex.for under VMS, cfortex.f on other machines.] + +The cfortran.h package continues to be developed. The most recent version is +available via www at http://www-zeus.desy.de/~burow +or via anonymous ftp at zebra.desy.de (131.169.2.244). + +The examples may be run using one of the following sets of instructions: + +N.B. Unlike earlier versions, cfortran.h 3.0 and later versions + automatically uses the correct ANSI ## or pre-ANSI /**/ + preprocessor operator as required by the C compiler. + +N.B. As a general rule when trying to determine how to link C and Fortran, + link a trivial Fortran program using the Fortran compilers verbose option, + in order to see how the Fortran compiler drives the linker. e.g. + unix> cat f.f + END + unix> f77 -v f.f + .. lots of info. follows ... + +N.B. If using a C main(), i.e. Fortran PROGRAM is not entry of the executable, + and if the link bombs with a complaint about + a missing "MAIN" (e.g. MAIN__, MAIN_, f90_main or similar), + then Fortran has hijacked the entry point to the executable + and wishes to call the rest of the executable via "MAIN". + This can usually be satisfied by doing e.g. 'cc -Dmain=MAIN__ ...' + but often kills the command line arguments in argv and argc. + The f77 verbose option, usually -v, may point to a solution. + + +RS/6000> # Users are strongly urged to use f77 -qextname and cc -Dextname +RS/6000> # Use -Dextname=extname if extname is a symbol used in the C code. +RS/6000> xlf -c -qextname cfortex.f +RS/6000> cc -c -Dextname cfortest.c +RS/6000> xlf -o cfortest cfortest.o cfortex.o && cfortest + +DECFortran> #Only DECstations with DECFortran for Ultrix RISC Systems. +DECFortran> cc -c -DDECFortran cfortest.c +DECFortran> f77 -o cfortest cfortest.o cfortex.f && cfortest + +IRIX xxxxxx 5.2 02282015 IP20 mips +MIPS> # DECstations and Silicon Graphics using the MIPS compilers. +MIPS> cc -o cfortest cfortest.c cfortex.f -lI77 -lU77 -lF77 && cfortest +MIPS> # Can also let f77 drive linking, e.g. +MIPS> cc -c cfortest.c +MIPS> f77 -o cfortest cfortest.o cfortex.f && cfortest + +Apollo> # Some 'C compiler 68K Rev6.8' break. [See Section II o) Notes: Apollo] +Apollo> f77 -c cfortex.f && cc -o cfortest cfortest.c cfortex.o && cfortest + +VMS> define lnk$library sys$library:vaxcrtl +VMS> cc cfortest.c +VMS> fortran cfortex.for +VMS> link/exec=cfortest cfortest,cfortex +VMS> run cfortest + +OSF1 xxxxxx V3.0 347 alpha +Alpha/OSF> # Probably better to let cc drive linking, e.g. +Alpha/OSF> f77 -c cfortex.f +Alpha/OSF> cc -o cfortest cfortest.c cfortex.o -lUfor -lfor -lFutil -lots -lm +Alpha/OSF> cfortest +Alpha/OSF> # Else may need 'cc -Dmain=MAIN__' to let f77 drive linking. + +Sun> # Some old cc(1) need a little help. [See Section II o) Notes: Sun] +Sun> f77 -o cfortest cfortest.c cfortex.f -lc -lm && cfortest +Sun> # Some older f77 may require 'cc -Dmain=MAIN_'. + +CRAY> cft77 cfortex.f +CRAY> cc -c cfortest.c +CRAY> segldr -o cfortest.e cfortest.o cfortex.o +CRAY> ./cfortest.e + +NEC> cc -c -Xa cfortest.c +NEC> f77 -o cfortest cfortest.o cfortex.f && cfortest + +VAX/Ultrix/cc> # For cc on VAX Ultrix only, do the following once to cfortran.h. +VAX/Ultrix/cc> mv cfortran.h cftmp.h && grep -v "^#pragma" <cftmp.h >cfortran.h + +VAX/Ultrix/f77> # In the following, 'CC' is either 'cc' or 'gcc -ansi'. NOT'vcc' +VAX/Ultrix/f77> CC -c -Dmain=MAIN_ cfortest.c +VAX/Ultrix/f77> f77 -o cfortest cfortex.f cfortest.o && cfortest + +LynxOS> # In the following, 'CC' is either 'cc' or 'gcc -ansi'. +LynxOS> # Unfortunately cc is easily overwhelmed by cfortran.h, +LynxOS> # and won't compile some of the cfortest.c demos. +LynxOS> f2c -R cfortex.f +LynxOS> CC -Dlynx -o cfortest cfortest.c cfortex.c -lf2c && cfortest + +HP9000> # Tested with HP-UX 7.05 B 9000/380 and with A.08.07 A 9000/730 +HP9000> # CC may be either 'c89 -Aa' or 'cc -Aa' +HP9000> # Depending on the compiler version, you may need to include the +HP9000> # option '-tp,/lib/cpp' or worse, you'll have to stick to the K&R C. +HP9000> # [See Section II o) Notes: HP9000] +HP9000> # Users are strongly urged to use f77 +ppu and cc -Dextname +HP9000> # Use -Dextname=extname if extname is a symbol used in the C code. +HP9000> CC -Dextname -c cfortest.c +HP9000> f77 +ppu cfortex.f -o cfortest cfortest.o && cfortest +HP9000> # Older f77 may need +HP9000> f77 -c cfortex.f +HP9000> CC -o cfortest cfortest.c cfortex.o -lI77 -lF77 && cfortest + +HP0000> # If old-style f77 +800 compiled objects are required: +HP9000> # #define hpuxFortran800 +HP9000> cc -c -Aa -DhpuxFortran800 cfortest.c +HP9000> f77 +800 -o cfortest cfortest.o cfortex.f + +f2c> # In the following, 'CC' is any C compiler. +f2c> f2c -R cfortex.f +f2c> CC -o cfortest -Df2cFortran cfortest.c cfortex.c -lf2c && cfortest + +Portland Group $ # Presumably other C compilers also work. +Portland Group $ pgcc -DpgiFortran -c cfortest.c +Portland Group $ pgf77 -o cfortest cfortex.f cfortest.o && cfortest + +NAGf90> # cfortex.f is distributed with Fortran 77 style comments. +NAGf90> # To convert to f90 style comments do the following once to cfortex.f: +NAGf90> mv cfortex.f cf_temp.f && sed 's/^C/\!/g' cf_temp.f > cfortex.f +NAGf90> # In the following, 'CC' is any C compiler. +NAGf90> CC -c -DNAGf90Fortran cfortest.c +NAGf90> f90 -o cfortest cfortest.o cfortex.f && cfortest + +PC> # On a PC with PowerStation Fortran and Visual_C++ +PC> cl /c cftest.c +PC> fl32 cftest.obj cftex.for + +GNU> # GNU Fortran +GNU> # See Section VI caveat on using 'gcc -traditional'. +GNU> gcc -ansi -Wall -O -c -Df2cFortran cfortest.c +GNU> g77 -ff2c -o cfortest cfortest.o cfortex.f && cfortest + +AbsoftUNIX> # Absoft Fortran for all UNIX based operating systems. +AbsoftUNIX> # e.g. Linux or Next on Intel or Motorola68000. +AbsoftUNIX> # Absoft f77 -k allows Fortran routines to be safely called from C. +AbsoftUNIX> gcc -ansi -Wall -O -c -DAbsoftUNIXFortran cfortest.c +AbsoftUNIX> f77 -k -o cfortest cfortest.o cfortex.f && cfortest + +AbsoftPro> # Absoft Pro Fortran for MacOS +AbsoftPro> # Use #define AbsoftProFortran + +CLIPPER> # INTERGRAPH CLIX using CLIPPER C and Fortran compilers. +CLIPPER> # N.B. - User, not cfortran.h, is responsible for +CLIPPER> # f77initio() and f77uninitio() if required. +CLIPPER> # - LOGICAL values are not mentioned in CLIPPER doc.s, +CLIPPER> # so they may not yet be correct in cfortran.h. +CLIPPER> # - K&R mode (-knr or Ac=knr) breaks FLOAT functions +CLIPPER> # (see CLIPPER doc.s) and cfortran.h does not fix it up. +CLIPPER> # [cfortran.h ok for old sun C which made the same mistake.] +CLIPPER> acc cfortest.c -c -DCLIPPERFortran +CLIPPER> af77 cfortex.f cfortest.o -o cfortest + + +By changing the SELECTion ifdef of cfortest.c and recompiling one can try out +a few dozen different few-line examples. + + + +The benefits of using cfortran.h include: +1. Machine/OS/compiler independent mixing of C and FORTRAN. + +2. Identical (within syntax) calls across languages, e.g. +C FORTRAN + CALL HBOOK1(1,'pT spectrum of pi+',100,0.,5.,0.) +/* C*/ + HBOOK1(1,"pT spectrum of pi+",100,0.,5.,0.); + +3. Each routine need only be set up once in its lifetime. e.g. +/* Setting up a FORTRAN routine to be called by C. + ID,...,VMX are merely the names of arguments. + These tags must be unique w.r.t. each other but are otherwise arbitrary. */ +PROTOCCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT) +#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \ + CCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT, \ + ID,CHTITLE,NX,XMI,XMA,VMX) + +4. Source code is NOT required for the C routines exported to FORTRAN, nor for + the FORTRAN routines imported to C. In fact, routines are most easily + prototyped using the information in the routines' documentation. + +5. Routines, and the code calling them, can be coded naturally in the language + of choice. C routines may be coded with the natural assumption of being + called only by C code. cfortran.h does all the required work for FORTRAN + code to call C routines. Similarly it also does all the work required for C + to call FORTRAN routines. Therefore: + - C programmers need not embed FORTRAN argument passing mechanisms into + their code. + - FORTRAN code need not be converted into C code. i.e. The honed and + time-honored FORTRAN routines are called by C. + +6. cfortran.h is a single ~1700 line C include file; portable to most + remaining, if not all, platforms. + +7. STRINGS and VECTORS of STRINGS along with the usual simple arguments to + routines are supported as are functions returning STRINGS or numbers. Arrays + of pointers to strings and values of structures as C arguments, will soon be + implemented. After learning the machinery of cfortran.h, users can expand + it to create custom types of arguments. [This requires no modification to + cfortran.h, all the preprocessor directives required to implement the + custom types can be defined outside cfortran.h] + +8. cfortran.h requires each routine to be exported to be explicitly set up. + While is usually only be done once in a header file it would be best if + applications were required to do no work at all in order to cross languages. + cfortran.h's simple syntax could be a convenient back-end for a program + which would export FORTRAN or C routines directly from the source code. + + + ----- + +Example 1 - cfortran.h has been used to make the C header file hbook.h, + which then gives any C programmer, e.g. example.c, full and + completely transparent access to CERN's HBOOK library of routines. + Each HBOOK routine required about 3 lines of simple code in + hbook.h. The example also demonstrates how FORTRAN common blocks + are defined and used. + +/* hbook.h */ +#include "cfortran.h" + : +PROTOCCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT) +#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \ + CCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT, \ + ID,CHTITLE,NX,XMI,XMA,VMX) + : +/* end hbook.h */ + +/* example.c */ +#include "hbook.h" + : +typedef struct { + int lines; + int status[SIZE]; + float p[SIZE]; /* momentum */ +} FAKE_DEF; +#define FAKE COMMON_BLOCK(FAKE,fake) +COMMON_BLOCK_DEF(FAKE_DEF,FAKE); + : +main () +{ + : + HBOOK1(1,"pT spectrum of pi+",100,0.,5.,0.); +/* c.f. the call in FORTRAN: + CALL HBOOK1(1,'pT spectrum of pi+',100,0.,5.,0.) +*/ + : + FAKE.p[7]=1.0; + : +} + +N.B. i) The routine is language independent. + ii) hbook.h is machine independent. + iii) Applications using routines via cfortran.h are machine independent. + + ----- + +Example 2 - Many VMS System calls are most easily called from FORTRAN, but + cfortran.h now gives that ease in C. + +#include "cfortran.h" + +PROTOCCALLSFSUB3(LIB$SPAWN,lib$spawn,STRING,STRING,STRING) +#define LIB$SPAWN(command,input_file,output_file) \ + CCALLSFSUB3(LIB$SPAWN,lib$spawn,STRING,STRING,STRING, \ + command,input_file,output_file) + +main () +{ +LIB$SPAWN("set term/width=132","",""); +} + +Obviously the cfortran.h command above could be put into a header file along +with the description of the other system calls, but as this example shows, it's +not much hassle to set up cfortran.h for even a single call. + + ----- + +Example 3 - cfortran.h and the source cstring.c create the cstring.obj library + which gives FORTRAN access to all the functions in C's system + library described by the system's C header file string.h. + +C EXAMPLE.FOR + PROGRAM EXAMPLE + DIMENSION I(20), J(30) + : + CALL MEMCPY(I,J,7) + : + END + +/* cstring.c */ +#include <string.h> /* string.h prototypes memcpy() */ +#include "cfortran.h" + + : +FCALLSCSUB3(memcpy,MEMCPY,memcpy,PVOID,PVOID,INT) + : + + +The simplicity exhibited in the above example exists for many but not all +machines. Note 4. of Section II ii) details the limitations and describes tools +which try to maintain the best possible interface when FORTRAN calls C +routines. + + ----- + + +II Using cfortran.h +------------------- + +The user is asked to look at the source files cfortest.c and cfortex.f +for clarification by example. + +o) Notes: + +o Specifying the Fortran compiler + cfortran.h generates interfaces for the default Fortran compiler. The default +can be overridden by defining, + . in the code, e.g.: #define NAGf90Fortran + OR . in the compile directive, e.g.: unix> cc -DNAGf90Fortran +one of the following before including cfortran.h: + NAGf90Fortran f2cFortran hpuxFortran apolloFortran sunFortran + IBMR2Fortran CRAYFortran mipsFortran DECFortran vmsFortran + CONVEXFortran PowerStationFortran AbsoftUNIXFortran + SXFortran pgiFortran AbsoftProFortran +This also allows crosscompilation. +If wanted, NAGf90Fortran, f2cFortran, DECFortran, AbsoftUNIXFortran, +AbsoftProFortran and pgiFortran must be requested by the user. + +o /**/ + cfortran.h (ab)uses the comment kludge /**/ when the ANSI C preprocessor +catenation operator ## doesn't exist. In at least MIPS C, this kludge is +sensitive to blanks surrounding arguments to macros. + Therefore, for applications using non-ANSI C compilers, the argtype_i, +routine_name, routine_type and common_block_name arguments to the +PROTOCCALLSFFUNn, CCALLSFSUB/FUNn, FCALLSCSUB/FUNn and COMMON_BLOCK macros +--- MUST NOT --- be followed by any white space characters such as +blanks, tabs or newlines. + +o LOGICAL + FORTRAN LOGICAL values of .TRUE. and .FALSE. do not agree with the C +representation of TRUE and FALSE on all machines. cfortran.h does the +conversion for LOGICAL and PLOGICAL arguments and for functions returning +LOGICAL. Users must convert arrays of LOGICALs from C to FORTRAN with the +C2FLOGICALV(array_name, elements_in_array); macro. Similarly, arrays of LOGICAL +values may be converted from the FORTRAN into C representation by using +F2CLOGICALV(array_name, elements_in_array); + + When C passes or returns LOGICAL values to FORTRAN, by default cfortran.h +only makes the minimal changes required to the value. [e.g. Set/Unset the +single relevant bit or do nothing for FORTRAN compilers which use 0 as FALSE +and treat all other values as TRUE.] Therefore cfortran.h will pass LOGICALs +to FORTRAN which do not have an identical representation to .TRUE. or .FALSE. +This is fine except for abuses of FORTRAN/77 in the style of: + logical l + if (l .eq. .TRUE.) ! (1) +instead of the correct: + if (l .eqv. .TRUE.) ! (2) +or: + if (l) ! (3) +For FORTRAN code which treats LOGICALs from C in the method of (1), +LOGICAL_STRICT must be defined before including cfortran.h, either in the +code, "#define LOGICAL_STRICT", or compile with "cc -DLOGICAL_STRICT". +There is no reason to use LOGICAL_STRICT for FORTRAN code which does not do (1). +At least the IBM's xlf and the Apollo's f77 do not even allow code along the +lines of (1). + + DECstations' DECFortran and MIPS FORTRAN compilers use different internal +representations for LOGICAL values. [Both compilers are usually called f77, +although when both are installed on a single machine the MIPS' one is usually +renamed. (e.g. f772.1 for version 2.10.)] cc doesn't know which FORTRAN +compiler is present, so cfortran.h assumes MIPS f77. To use cc with DECFortran +define the preprocessor constant 'DECFortran'. +e.g. i) cc -DDECFortran -c the_code.c + or ii) #define DECFortran /* in the C code or add to cfortran.h. */ + + MIPS f77 [SGI and DECstations], f2c, and f77 on VAX Ultrix treat +.eqv./.neqv. as .eq./.ne.. Therefore, for these compilers, LOGICAL_STRICT is +defined by default in cfortran.h. [The Sun and HP compilers have not been +tested, so they may also require LOGICAL_STRICT as the default.] + +o SHORT and BYTE + They are irrelevant for the CRAY where FORTRAN has no equivalent to C's short. +Similarly BYTE is irrelevant for f2c and for VAX Ultrix f77 and fort. The +author has tested SHORT and BYTE with a modified cfortest.c/cfortex.f on all +machines supported except for the HP9000 and the Sun. + + BYTE is a signed 8-bit quantity, i.e. values are -128 to 127, on all machines +except for the SGI [at least for MIPS Computer Systems 2.0.] On the SGI it is +an unsigned 8-bit quantity, i.e. values are 0 to 255, although the SGI 'FORTRAN +77 Programmers Guide' claims BYTE is signed. Perhaps MIPS 2.0 is dated, since +the DECstations using MIPS 2.10 f77 have a signed BYTE. + + To minimize the difficulties of signed and unsigned BYTE, cfortran.h creates +the type 'INTEGER_BYTE' to agree with FORTRAN's BYTE. Users may define +SIGNED_BYTE or UNSIGNED_BYTE, before including cfortran.h, to specify FORTRAN's +BYTE. If neither is defined, cfortran.h assumes SIGNED_BYTE. + +o CRAY + The type DOUBLE in cfortran.h corresponds to FORTRAN's DOUBLE PRECISION. + The type FLOAT in cfortran.h corresponds to FORTRAN's REAL. + +On a classic CRAY [i.e. all models except for the t3e]: +( 64 bit) C float == C double == Fortran REAL +(128 bit) C long double == Fortran DOUBLE PRECISION +Therefore when moving a mixed C and FORTRAN app. to/from a classic CRAY, +either the C code will have to change, +or the FORTRAN code and cfortran.h declarations will have to change. +DOUBLE_PRECISION is a cfortran.h macro which provides the former option, +i.e. the C code is automatically changed. +DOUBLE_PRECISION is 'long double' on classic CRAY and 'double' elsewhere. +DOUBLE_PRECISION thus corresponds to FORTRAN's DOUBLE PRECISION +on all machines, including classic CRAY. + +On a classic CRAY with the fortran compiler flag '-dp': +Fortran DOUBLE PRECISION thus is also the faster 64bit type. +(This switch is often used since the application is usually satisfied by + 64 bit precision and the application needs the speed.) +DOUBLE_PRECISION is thus not required in this case, +since the classic CRAY behaves like all other machines. +If DOUBLE_PRECISION is used nonetheless, then on the classic CRAY +the default cfortran.h behavior must be overridden, +for example by the C compiler option '-DDOUBLE_PRECISION=double'. + +On a CRAY t3e: +(32 bit) C float == Fortran Unavailable +(64 bit) C double == C long double == Fortran REAL == Fortran DOUBLE PRECISION +Notes: +- (32 bit) is available as Fortran REAL*4 and + (64 bit) is available as Fortran REAL*8. + Since cfortran.h is all about more portability, not about less portability, + the use of the nonstandard REAL*4 and REAL*8 is strongly discouraged. +- Fortran DOUBLE PRECISION is folded to REAL with the following warning: + 'DOUBLE PRECISION is not supported on this platform. REAL will be used.' + Similarly, Fortran REAL*16 is mapped to REAL*8 with a warning. +This behavior differs from that of other machines, including the classic CRAY. +FORTRAN_REAL is thus introduced for the t3e, +just as DOUBLE_PRECISION is introduced for the classic CRAY. +FORTRAN_REAL is 'double' on t3e and 'float' elsewhere. +FORTRAN_REAL thus corresponds to FORTRAN's REAL on all machines, including t3e. + + +o f2c + f2c, by default promotes REAL functions to double. cfortran.h does not (yet) +support this, so the f2c -R option must be used to turn this promotion off. + +o f2c +[Thanks to Dario Autiero for pointing out the following.] +f2c has a strange feature in that either one or two underscores are appended +to a Fortran name of a routine or common block, +depending on whether or not the original name contains an underscore. + + S.I. Feldman et al., "A fortran to C converter", + Computing Science Technical Report No. 149. + + page 2, chapter 2: INTERLANGUAGE conventions + ........... + To avoid conflict with the names of library routines and with names that + f2c generates, + Fortran names may have one or two underscores appended. Fortran names are + forced to lower case (unless the -U option described in Appendix B is in + effect); external names, i.e. the names of fortran procedures and common + blocks, have a single underscore appended if they do not contain any + underscore and have a pair of underscores appended if they do contain + underscores. Thus fortran subroutines names ABC, A_B_C and A_B_C_ result + in C functions named abc_, a_b_c__ and a_b_c___. + ........... + +cfortran.h is unable to change the naming convention on a name by name basis. +Fortran routine and common block names which do not contain an underscore +are unaffected by this feature. +Names which do contain an underscore may use the following work-around: + +/* First 2 lines are a completely standard cfortran.h interface + to the Fortran routine E_ASY . */ + PROTOCCALLSFSUB2(E_ASY,e_asy, PINT, INT) +#define E_ASY(A,B) CCALLSFSUB2(E_ASY,e_asy, PINT, INT, A, B) +#ifdef f2cFortran +#define e_asy_ e_asy__ +#endif +/* Last three lines are a work-around for the strange f2c naming feature. */ + +o NAG f90 + The Fortran 77 subset of Fortran 90 is supported. Extending cfortran.h to +interface C with all of Fortran 90 has not yet been examined. + The NAG f90 library hijacks the main() of any program and starts the user's +program with a call to: void f90_main(void); +While this in itself is only a minor hassle, a major problem arises because +NAG f90 provides no mechanism to access command line arguments. + At least version 'NAGWare f90 compiler Version 1.1(334)' appended _CB to +common block names instead of the usual _. To fix, add this to cfortran.h: +#ifdef old_NAG_f90_CB_COMMON +#define COMMON_BLOCK CFC_ /* for all other Fortran compilers */ +#else +#define COMMON_BLOCK(UN,LN) _(LN,_CB) +#endif + +o RS/6000 + Using "xlf -qextname ...", which appends an underscore, '_', to all FORTRAN +external references, requires "cc -Dextname ..." so that cfortran.h also +generates these underscores. +Use -Dextname=extname if extname is a symbol used in the C code. +The use of "xlf -qextname" is STRONGLY ENCOURAGED, since it allows for +transparent naming schemes when mixing C and Fortran. + +o HP9000 + Using "f77 +ppu ...", which appends an underscore, '_', to all FORTRAN +external references, requires "cc -Dextname ..." so that cfortran.h also +generates these underscores. +Use -Dextname=extname if extname is a symbol used in the C code. +The use of "f77 +ppu" is STRONGLY ENCOURAGED, since it allows for +transparent naming schemes when mixing C and Fortran. + + At least one release of the HP /lib/cpp.ansi preprocessor is broken and will +go into an infinite loop when trying to process cfortran.h with the +## catenation operator. The K&R version of cfortran.h must then be used and the +K&R preprocessor must be specified. e.g. + HP9000> cc -Aa -tp,/lib/cpp -c source.c +The same problem with a similar solution exists on the Apollo. +An irrelevant error message '0: extraneous name /usr/include' will appear for +each source file due to another HP bug, and can be safely ignored. +e.g. 'cc -v -c -Aa -tp,/lib/cpp cfortest.c' will show that the driver passes +'-I /usr/include' instead of '-I/usr/include' to /lib/cpp + +On some machines the above error causes compilation to stop; one must then use +K&R C, as with old HP compilers which don't support function prototyping. +cfortran.h has to be informed that K&R C is to being used, e.g. +HP9000> cc -D__CF__KnR -c source.c + +o AbsoftUNIXFortran +By default, cfortran.h follows the default AbsoftUNIX/ProFortran and prepends _C +to each COMMON BLOCK name. To override the cfortran.h behavior +#define COMMON_BLOCK(UN,LN) before #including cfortran.h. +[Search for COMMON_BLOCK in cfortran.h for examples.] + +o Apollo +On at least one release, 'C compiler 68K Rev6.8(168)', the default C +preprocessor, from cc -A xansi or cc -A ansi, enters an infinite loop when +using cfortran.h. This Apollo bug can be circumvented by using: + . cc -DANSI_C_preprocessor=0 to force use of /**/, instead of '##'. + AND . The pre-ANSI preprocessor, i.e. use cc -Yp,/usr/lib +The same problem with a similar solution exists on the HP. + +o Sun +Old versions of cc(1), say <~1986, may require help for cfortran.h applications: + . #pragma may not be understood, hence cfortran.h and cfortest.c may require + sun> mv cfortran.h cftmp.h && grep -v "^#pragma" <cftmp.h >cfortran.h + sun> mv cfortest.c cftmp.c && grep -v "^#pragma" <cftmp.c >cfortest.c + . Old copies of math.h may not include the following from a newer math.h. + [For an ancient math.h on a 386 or sparc, get similar from a new math.h.] + #ifdef mc68000 /* 5 lines Copyright (c) 1988 by Sun Microsystems, Inc. */ + #define FLOATFUNCTIONTYPE int + #define RETURNFLOAT(x) return (*(int *)(&(x))) + #define ASSIGNFLOAT(x,y) *(int *)(&x) = y + #endif + +o CRAY, Sun, Apollo [pre 6.8 cc], VAX Ultrix and HP9000 + Only FORTRAN routines with less than 15 arguments can be prototyped for C, +since these compilers don't allow more than 31 arguments to a C macro. This can +be overcome, [see Section IV], with access to any C compiler without this +limitation, e.g. gcc, on ANY machine. + +o VAX Ultrix + vcc (1) with f77 is not supported. Although: +VAXUltrix> f77 -c cfortex.f +VAXUltrix> vcc -o cfortest cfortest.c cfortex.o -lI77 -lU77 -lF77 && cfortest +will link and run. However, the FORTRAN standard I/O is NOT merged with the +stdin and stdout of C, and instead uses the files fort.6 and fort.5. For vcc, +f77 can't drive the linking, as for gcc and cc, since vcc objects must be +linked using lk (1). f77 -v doesn't tell much, and without VAX Ultrix manuals, +the author can only wait for the info. required. + + fort (1) is not supported. Without VAX Ultrix manuals the author cannot +convince vcc/gcc/cc and fort to generate names of routines and COMMON blocks +that match at the linker, lk (1). i.e. vcc/gcc/cc prepend a single underscore +to external references, e.g. NAME becomes _NAME, while fort does not modify the +references. So ... either fort has prepend an underscore to external +references, or vcc/gcc/cc have to generate unmodified names. man 1 fort +mentions JBL, is JBL the only way? + +o VAX VMS C + The compiler 'easily' exhausts its table space and generates: +%CC-F-BUGCHECK, Compiler bug check during parser phase . + Submit an SPR with a problem description. + At line number 777 in DISK:[DIR]FILE.C;1. +where the line given, '777', includes a call across C and FORTRAN via +cfortran.h, usually with >7 arguments and/or very long argument expressions. +This SPR can be staved off, with the simple modification to cfortran.h, such +that the relevant CCALLSFSUBn (or CCALLSFFUNn or FCALLSCFUNn) is not +cascaded up to CCALLSFSUB14, and instead has its own copy of the contents of +CCALLSFSUB14. [If these instructions are not obvious after examining cfortran.h +please contact the author.] +[Thanks go to Mark Kyprianou (kyp@stsci.edu) for this solution.] + +o Mips compilers + e.g. DECstations and SGI, require applications with a C main() and calls to +GETARG(3F), i.e. FORTRAN routines returning the command line arguments, to use +two macros as shown: + : +CF_DECLARE_GETARG; /* This must be external to all routines. */ + : +main(int argc, char *argv[]) +{ + : +CF_SET_GETARG(argc,argv); /* This must precede any calls to GETARG(3F). */ + : +} +The macros are null and benign on all other systems. Sun's GETARG(3F) also +doesn't work with a generic C main() and perhaps a workaround similar to the +Mips' one exists. + +o Alpha/OSF +Using the DEC Fortran and the DEC C compilers of DEC OSF/1 [RT] V1.2 (Rev. 10), +Fortran, when called from C, has occasional trouble using a routine received as +a dummy argument. + +e.g. In the following the Fortran routine 'e' will crash when it tries to use + the C routine 'c' or the Fortran routine 'f'. + The example works on other systems. + +C FORTRAN /* C */ + integer function f() #include <stdio.h> + f = 2 int f_(); + return int e_(int (*u)()); + end + int c(){ return 1;} + integer function e(u) int d (int (*u)()) { return u();} + integer u + external u main() + e=u() { /* Calls to d work. */ + return printf("d (c ) returns %d.\n",d (c )); + end printf("d (f_) returns %d.\n",d (f_)); + /* Calls to e_ crash. */ + printf("e_(c ) returns %d.\n",e_(c )); + printf("e_(f_) returns %d.\n",e_(f_)); + } + +Solutions to the problem are welcomed! +A kludge which allows the above example to work correctly, requires an extra +argument to be given when calling the dummy argument function. +i.e. Replacing 'e=u()' by 'e=u(1)' allows the above example to work. + + +o The FORTRAN routines are called using macro expansions, therefore the usual +caveats for expressions in arguments apply. The expressions to the routines may +be evaluated more than once, leading to lower performance and in the worst case +bizarre bugs. + +o For those who wish to use cfortran.h in large applications. [See Section IV.] +This release is intended to make it easy to get applications up and running. +This implies that applications are not as efficient as they could be: +- The current mechanism is inefficient if a single header file is used to + describe a large library of FORTRAN functions. Code for a static wrapper fn. + is generated in each piece of C source code for each FORTRAN function + specified with the CCALLSFFUNn statement, irrespective of whether or not the + function is ever called. +- Code for several static utility routines internal to cfortran.h is placed + into any source code which #includes cfortran.h. These routines should + probably be in a library. + + +i) Calling FORTRAN routines from C: + -------------------------------- + +The FORTRAN routines are defined by one of the following two instructions: + +for a SUBROUTINE: +/* PROTOCCALLSFSUBn is optional for C, but mandatory for C++. */ +PROTOCCALLSFSUBn(ROUTINE_NAME,routine_name,argtype_1,...,argtype_n) +#define Routine_name(argname_1,..,argname_n) \ +CCALLSFSUBn(ROUTINE_NAME,routine_name,argtype_1,...,argtype_n, \ + argname_1,..,argname_n) + +for a FUNCTION: +PROTOCCALLSFFUNn(routine_type,ROUTINE_NAME,routine_name,argtype_1,...,argtype_n) +#define Routine_name(argname_1,..,argname_n) \ +CCALLSFFUNn(ROUTINE_NAME,routine_name,argtype_1,...,argtype_n, \ + argname_1,..,argname_n) + +Where: +'n' = 0->14 [SUBROUTINE's ->27] (easily expanded in cfortran.h to > 14 [27]) is + the number of arguments to the routine. +Routine_name = C name of the routine (IN UPPER CASE LETTERS).[see 2.below] +ROUTINE_NAME = FORTRAN name of the routine (IN UPPER CASE LETTERS). +routine_name = FORTRAN name of the routine (IN lower case LETTERS). +routine_type = the type of argument returned by FORTRAN functions. + = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, STRING, VOID. + [Instead of VOID one would usually use CCALLSFSUBn. + VOID forces a wrapper function to be used.] +argtype_i = the type of argument passed to the FORTRAN routine and must be + consistent in the definition and prototyping of the routine s.a. + = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, STRING. + For vectors, i.e. 1 dim. arrays use + = BYTEV, DOUBLEV, FLOATV, INTV, LOGICALV, LONGV, SHORTV, + STRINGV, ZTRINGV. + For vectors of vectors, i.e. 2 dim. arrays use + = BYTEVV, DOUBLEVV, FLOATVV, INTVV, LOGICALVV, LONGVV, SHORTVV. + For n-dim. arrays, 1<=n<=7 [7 is the maximum in Fortran 77], + = BYTEV..nV's..V, DOUBLEV..V, FLOATV..V, INTV..V, LOGICALV..V, + LONGV..V, SHORTV..V. + N.B. Array dimensions and types are checked by the C compiler. + For routines changing the values of an argument, the keyword is + prepended by a 'P'. + = PBYTE, PDOUBLE, PFLOAT, PINT, PLOGICAL, PLONG, PSHORT, + PSTRING, PSTRINGV, PZTRINGV. + For EXTERNAL procedures passed as arguments use + = ROUTINE. + For exceptional arguments which require no massaging to fit the + argument passing mechanisms use + = PVOID. + The argument is cast and passed as (void *). + Although PVOID could be used to describe all array arguments on + most (all?) machines , it shouldn't be because the C compiler + can no longer check the type and dimension of the array. +argname_i = any valid unique C tag, but must be consistent in the definition + as shown. + +Notes: + +1. cfortran.h may be expanded to handle a more argument type. To suppport new +arguments requiring complicated massaging when passed between Fortran and C, +the user will have to understand cfortran.h and follow its code and mechanisms. + +To define types requiring little or no massaging when passed between Fortran +and C, the pseudo argument type SIMPLE may be used. +For a user defined type called 'newtype', the definitions required are: + +/* The following 7 lines are required verbatim. + 'newtype' is the name of the new user defined argument type. +*/ +#define newtype_cfV( T,A,B,F) SIMPLE_cfV(T,A,B,F) +#define newtype_cfSEP(T, B) SIMPLE_cfSEP(T,B) +#define newtype_cfINT(N,A,B,X,Y,Z) SIMPLE_cfINT(N,A,B,X,Y,Z) +#define newtype_cfSTR(N,T,A,B,C,D,E) SIMPLE_cfSTR(N,T,A,B,C,D,E) +#define newtype_cfCC( T,A,B) SIMPLE_cfCC(T,A,B) +#define newtype_cfAA( T,A,B) newtype_cfB(T,A) /* Argument B not used. */ +#define newtype_cfU( T,A) newtype_cfN(T,A) + +/* 'parameter_type(A)' is a declaration for 'A' and describes the type of the +parameter expected by the Fortran function. This type will be used in the +prototype for the function, if using ANSI C, and to declare the argument used +by the intermediate function if calling a Fortran FUNCTION. +Valid 'parameter_type(A)' include: int A + void (*A)() + double A[17] +*/ +#define newtype_cfN( T,A) parameter_type(A) /* Argument T not used. */ + +/* Before any argument of the new type is passed to the Fortran routine, it may +be massaged as given by 'massage(A)'. +*/ +#define newtype_cfB( T,A) massage(A) /* Argument T not used. */ + +An example of a simple user defined type is given cfortex.f and cfortest.c. +Two uses of SIMPLE user defined types are [don't show the 7 verbatim #defines]: + +/* Pass the address of a structure, using a type called PSTRUCT */ +#define PSTRUCT_cfN( T,A) void *A +#define PSTRUCT_cfB( T,A) (void *) &(A) + +/* Pass an integer by value, (not standard F77 ), using a type called INTVAL */ +#define INTVAL_cfN( T,A) int A +#define INTVAL_cfB( T,A) (A) + +[If using VAX VMS, surrounding the #defines with "#pragma (no)standard" allows + the %CC-I-PARAMNOTUSED messages to be avoided.] + +Upgrades to cfortran.h try to be, and have been, backwards compatible. This +compatibility cannot be offered to user defined types. SIMPLE user defined +types are less of a risk since they require so little effort in their creation. +If a user defined type is required in more than one C header file of interfaces +to libraries of Fortran routines, good programming practice, and ease of code +maintenance, suggests keeping any user defined type within a single file which +is #included as required. To date, changes to the SIMPLE macros were introduced +in versions 2.6, 3.0 and 3.2 of cfortran.h. + + +2. Routine_name is the name of the macro which the C programmer will use in +order to call a FORTRAN routine. In theory Routine_name could be any valid and +unique name, but in practice, the name of the FORTRAN routine in UPPER CASE +works everywhere and would seem to be an obvious choice. + + +3. <BYTE|DOUBLE|BYTE|DOUBLE|FLOAT|INT|LOGICAL|LONG|SHORT><V|VV|VVV|...> + +cfortran.h encourages the exact specification of the type and dimension of +array parameters because it allows the C compiler to detect errors in the +arguments when calling the routine. + +cfortran.h does not strictly require the exact specification since the argument +is merely the address of the array and is passed on to the calling routine. +Any array parameter could be declared as PVOID, but this circumvents +C's compiletime ability to check the correctness of arguments and is therefore +discouraged. + +Passing the address of these arguments implies that PBYTEV, PFLOATV, ... , +PDOUBLEVV, ... don't exist in cfortran.h, since by default the routine and the +calling code share the same array, i.e. the same values at the same memory +location. + +These comments do NOT apply to arrays of (P)S/ZTRINGV. For these parameters, +cfortran.h passes a massaged copy of the array to the routine. When the routine +returns, S/ZTRINGV ignores the copy, while PS/ZTRINGV replaces the calling +code's original array with copy, which may have been modified by the called +routine. + + +4. (P)STRING(V): +- STRING - If the argument is a fixed length character array, e.g. char ar[8];, +the string is blank, ' ', padded on the right to fill out the array before +being passed to the FORTRAN routine. The useful size of the string is the same +in both languages, e.g. ar[8] is passed as character*7. If the argument is a +pointer, the string cannot be blank padded, so the length is passed as +strlen(argument). On return from the FORTRAN routine, pointer arguments are not +disturbed, but arrays have the terminating '\0' replaced to its original +position. i.e. The padding blanks are never visible to the C code. + +- PSTRING - The argument is massaged as with STRING before being passed to the +FORTRAN routine. On return, the argument has all trailing blanks removed, +regardless of whether the argument was a pointer or an array. + +- (P)STRINGV - Passes a 1- or 2-dimensional char array. e.g. char a[7],b[6][8]; +STRINGV may thus also pass a string constant, e.g. "hiho". +(P)STRINGV does NOT pass a pointer, e.g. char *, to either a 1- or a +2-dimensional array, since it cannot determine the array dimensions. +A pointer can only be passed using (P)ZTRINGV. +N.B. If a C routine receives a character array argument, e.g. char a[2][3], + such an argument is actually a pointer and my thus not be passed by + (P)STRINGV. Instead (P)ZTRINGV must be used. + +- STRINGV - The elements of the argument are copied into space malloc'd, and +each element is padded with blanks. The useful size of each element is the same +in both languages. Therefore char bb[6][8]; is equivalent to character*7 bb(6). +On return from the routine the malloc'd space is simply released. + +- PSTRINGV - Since FORTRAN has no trailing '\0', elements in an array of +strings are contiguous. Therefore each element of the C array is padded with +blanks and strip out C's trailing '\0'. After returning from the routine, the +trailing '\0' is reinserted and kill the trailing blanks in each element. + +- SUMMARY: STRING(V) arguments are blank padded during the call to the FORTRAN +routine, but remain original in the C code. (P)STRINGV arguments are blank +padded for the FORTRAN call, and after returning from FORTRAN trailing blanks +are stripped off. + + +5. (P)ZTRINGV: +- (P)ZTRINGV - is identical to (P)STRINGV, +except that the dimensions of the array of strings is explicitly specified, +which thus also allows a pointer to be passed. +(P)ZTRINGV can thus pass a 1- or 2-dimensional char array, e.g. char b[6][8], +or it can pass a pointer to such an array, e.g. char *p;. +ZTRINGV may thus also pass a string constant, e.g. "hiho". +If passing a 1-dimensional array, routine_name_ELEMS_j (see below) must be 1. +[Users of (P)ZTRINGV should examine cfortest.c for examples.]: + +- (P)ZTRINGV must thus be used instead of (P)STRINGV whenever sizeof() +can't be used to determine the dimensions of the array of string or strings. +e.g. when calling FORTRAN from C with a char * received by C as an argument. + +- There is no (P)ZTRING type, since (P)ZTRINGV can pass a 1-dimensional +array or a pointer to such an array, e.g. char a[7], *b; +If passing a 1-dimensional array, routine_name_ELEMS_j (see below) must be 1. + +- To specify the numbers of elements, +routine_name_ELEMS_j and routine_name_ELEMLEN_j must be defined as shown below +before interfacing the routine with CCALLSFSUBn, PROTOCCALLSFFUNn, etc. + +#define routine_name_ELEMS_j ZTRINGV_ARGS(k) + [..ARGS for subroutines, ..ARGF for functions.] +or +#define routine_name_ELEMS_j ZTRINGV_NUM(l) +Where: routine_name is as above. + j [1-n], is the argument being specifying. + k [1-n], the value of the k'th argument is the dynamic number + of elements for argument j. The k'th argument must be + of type BYTE, DOUBLE, FLOAT, INT, LONG or SHORT. + l the number of elements for argument j. This must be an + integer constant available at compile time. + i.e. it is static. + +- Similarly to specify the useful length, [i.e. don't count C's trailing '\0',] +of each element: +#define routine_name_ELEMLEN_j ZTRINGV_ARGS(m) + [..ARGS for subroutines, ..ARGF for functions.] +or +#define routine_name_ELEMLEN_j ZTRINGV_NUM(q) +Where: m [1-n], as for k but this is the length of each element. + q as for l but this is the length of each element. + + +6. ROUTINE +The argument is an EXTERNAL procedure. + +When C passes a routine to Fortran, the language of the function must be +specified as follows: [The case of some_*_function must be given as shown.] + +When C passes a C routine to a Fortran: + FORTRAN_ROUTINE(arg1, .... , + C_FUNCTION(SOME_C_FUNCTION,some_c_function), + ...., argn); + +and similarly when C passes a Fortran routine to Fortran: + FORTRAN_ROUTINE(arg1, .... , + FORTRAN_FUNCTION(SOME_FORT_FUNCTION,some_fort_function), + ...., argn); + +If fcallsc has been redefined; the same definition of fcallsc used when creating +the wrapper for 'some_c_function' must also be defined when C_FUNCTION is used. +See ii) 4. of this section for when and how to redefine fcallsc. + +ROUTINE was introduced with cfortran.h version 2.6. Earlier versions of +cfortran.h used PVOID to pass external procedures as arguments. Using PVOID for +this purpose is no longer recommended since it won't work 'as is' for +apolloFortran, hpuxFortran800, AbsoftUNIXFortran, AbsoftProFortran. + +7. CRAY only: +In a given piece of source code, where FFUNC is any FORTRAN routine, +FORTRAN_FUNCTION(FFUNC,ffunc) +disallows a previous +#define FFUNC(..) CCALLSFSUBn(FFUNC,ffunc,...) [ or CCALLSFFUNn] +in order to make the UPPER CASE FFUNC callable from C. +#define Ffunc(..) ... is OK though, as are obviously any other names. + + +ii) Calling C routines from FORTRAN: + -------------------------------- + +Each of the following two statements to export a C routine to FORTRAN create +FORTRAN 'wrappers', written in C, which must be compiled and linked along with +the original C routines and with the FORTRAN calling code. + +FORTRAN callable 'wrappers' may also be created for C macros. i.e. in this +section, the term 'C function' may be replaced by 'C macro'. + +for C functions returning void: +FCALLSCSUBn( Routine_name,ROUTINE_NAME,routine_name,argtype_1,...,argtype_n) + +for all other C functions: +FCALLSCFUNn(routine_type,Routine_name,ROUTINE_NAME,routine_name,argtype_1,...,argtype_n) + +Where: +'n' = 0->27 (easily expanded to > 27) stands for the number of arguments to the + routine. +Routine_name = the C name of the routine. [see 9. below] +ROUTINE_NAME = the FORTRAN name of the routine (IN UPPER CASE LETTERS). +routine_name = the FORTRAN name of the routine (IN lower case LETTERS). +routine_type = the type of argument returned by C functions. + = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, STRING, VOID. + [Instead of VOID, FCALLSCSUBn is recommended.] +argtype_i = the type of argument passed to the FORTRAN routine and must be + consistent in the definition and prototyping of the routine + = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG, SHORT, STRING. + For vectors, i.e. 1 dim. arrays use + = BYTEV, DOUBLEV, FLOATV, INTV, LOGICALV, LONGV, SHORTV, STRINGV. + For vectors of vectors, 2 dim. arrays use + = BYTEVV, DOUBLEVV, FLOATVV, INTVV, LOGICALVV, LONGVV, SHORTVV. + For n-dim. arrays use + = BYTEV..nV's..V, DOUBLEV..V, FLOATV..V, INTV..V, LOGICALV..V, + LONGV..V, SHORTV..V. + For routines changing the values of an argument, the keyword is + prepended by a 'P'. + = PBYTE, PDOUBLE, PFLOAT, PINT, PLOGICAL, PLONG, PSHORT, + PSTRING, PNSTRING, PPSTRING, PSTRINGV. + For EXTERNAL procedures passed as arguments use + = ROUTINE. + For exceptional arguments which require no massaging to fit the + argument passing mechanisms use + = PVOID. + The argument is cast and passed as (void *). + + +Notes: + +0. For Fortran calling C++ routines, C++ does NOT easily allow support for: + STRINGV. + BYTEVV, DOUBLEVV, FLOATVV, INTVV, LOGICALVV, LONGVV, SHORTVV. + BYTEV..V, DOUBLEV..V, FLOATV..V, INTV..V, LOGICALV..V, LONGV..V, SHORTV..V. +Though there are ways to get around this restriction, +the restriction is not serious since these types are unlikely to be used as +arguments for a C++ routine. + +1. FCALLSCSUB/FUNn expect that the routine to be 'wrapped' has been properly +prototyped, or at least declared. + + +2. cfortran.h may be expanded to handle a new argument type not already among +the above. + + +3. <BYTE|DOUBLE|BYTE|DOUBLE|FLOAT|INT|LOGICAL|LONG|SHORT><V|VV|VVV|...> + +cfortran.h encourages the exact specification of the type and dimension of +array parameters because it allows the C compiler to detect errors in the +arguments when declaring the routine using FCALLSCSUB/FUNn, assuming the +routine to be 'wrapped' has been properly prototyped. + +cfortran.h does not strictly require the exact specification since the argument +is merely the address of the array and is passed on to the calling routine. +Any array parameter could be declared as PVOID, but this circumvents +C's compiletime ability to check the correctness of arguments and is therefore +discouraged. + +Passing the address of these arguments implies that PBYTEV, PFLOATV, ... , +PDOUBLEVV, ... don't exist in cfortran.h, since by default the routine and the +calling code share the same array, i.e. the same values at the same memory +location. + +These comments do NOT apply to arrays of (P)STRINGV. For these parameters, +cfortran.h passes a massaged copy of the array to the routine. When the routine +returns, STRINGV ignores the copy, while PSTRINGV replaces the calling +code's original array with copy, which may have been modified by the called +routine. + + +4. (P(N))STRING arguments have any trailing blanks removed before being passed +to C, the same holds true for each element in (P)STRINGV. Space is malloc'd in +all cases big enough to hold the original string (elements) as well as C's +terminating '\0'. i.e. The useful size of the string (elements) is the same in +both languages. P(N)STRING(V) => the string (elements) will be copied from the +malloc'd space back into the FORTRAN bytes. If one of the two escape mechanisms +mentioned below for PNSTRING has been used, the copying back to FORTRAN is +obviously not relevant. + + +5. (PN)STRING's, [NOT PSTRING's nor (P)STRINGV's,] behavior may be overridden +in two cases. In both cases PNSTRING and STRING behave identically. + +a) If a (PN)STRING argument's first 4 bytes are all the NUL character, +i.e. '\0\0\0\0' the NULL pointer is passed to the C routine. + +b) If the characters of a (PN)STRING argument contain at least one HEX-00, i.e. +the NUL character, i.e. C strings' terminating '\0', the address of the string +is simply passed to the C routine. i.e. The argument is treated in this case as +it would be with PPSTRING, to which we refer the reader for more detail. + +Mechanism a) overrides b). Therefore, to use this mechanism to pass the NULL +string, "", to C, the first character of the string must obviously be the NUL +character, but of the first 4 characters in the string, at least one must not +be HEX-00. + +Example: +C FORTRAN /* C */ + character*40 str #include "cfortran.h" +C Set up a NULL as : void cs(char *s) {if (s) printf("%s.\n",s);} +C i) 4 NUL characters. FCALLSCSUB1(cs,CS,cs,STRING) +C ii) NULL pointer. + character*4 NULL + NULL = CHAR(0)//CHAR(0)//CHAR(0)//CHAR(0) + + data str/'just some string'/ + +C Passing the NULL pointer to cs. + call cs(NULL) +C Passing a copy of 'str' to cs. + call cs(str) +C Passing address of 'str' to cs. Trailing blanks NOT killed. + str(40:) = NULL + call cs(str) + end + +Strings passed from Fortran to C via (PN)STRING must not have undefined +contents, otherwise undefined behavior will result, since one of the above two +escape mechanisms may occur depending on the contents of the string. + +This is not be a problem for STRING arguments, which are read-only in the C +routine and hence must have a well defined value when being passed in. + +PNSTRING arguments require special care. Even if they are write-only in the C +routine, PNSTRING's above two escape mechanisms require that the value of the +argument be well defined when being passed in from Fortran to C. Therefore, +unless one or both of PNSTRING's escape mechanisms are required, PSTRING should +be used instead of PNSTRING. +Prior to version 2.8, PSTRING did have the above two escape mechanisms, +but they were removed from PSTRING to allow strings with undefined contents to +be passed in. PNSTRING behaves like the old PSTRING. +[Thanks go to Paul Dubois (dubios@icf.llnl.gov) for pointing out that PSTRING + must allow for strings with undefined contents to be passed in.] + +Example: +C FORTRAN /* C */ + character*10 s,sn #include "cfortran.h" + void ps(char *s) {strcpy(s,"hello");} +C Can call ps with undef. s. FCALLSCSUB1(ps,PS,ps,PSTRING) + call ps(s) FCALLSCSUB1(ps,PNS,pns,PNSTRING) + print *,s,'=s' + +C Can't call pns with undef. s. +C e.g. If first 4 bytes of s were +C "\0\0\0\0", ps would try +C to copy to NULL because +C of PNSTRING mechanism. + sn = "" + call pns(sn) + print *,sn,'=sn' + + end + + +6. PPSTRING +The address of the string argument is simply passed to the C routine. Therefore +the C routine and the FORTRAN calling code share the same string at the same +memory location. If the C routine modifies the string, the string will also be +modified for the FORTRAN calling code. +The user is responsible for negociating the differences in representation of a +string in Fortran and in C, i.e. the differences are not automatically resolved +as they are for (P(N)STRING(V). +This mechanism is provided for two reasons: + - Some C routines require the string to exist at the given memory location, + after the C routine has exited. Recall that for the usual (P(N)STRING(V) + mechanism, a copy of the FORTRAN string is given to the C routine, and this + copy ceases to exist after returning to the FORTRAN calling code. + - This mechanism can save runtime CPU cycles over (P(N)STRING(V), since it + does not perform their malloc, copy and kill trailing blanks of the string + to be passed. + Only in a small minority of cases does the potential benefit of the saved + CPU cycles outweigh the programming effort required to manually resolve + the differences in representation of a string in Fortran and in C. + +For arguments passed via PPSTRING, the argument passed may also be an array of +strings. + + +7. ROUTINE +ANSI C requires that the type of the value returned by the routine be known, +For all ROUTINE arguments passed from Fortran to C, the type of ROUTINE is +specified by defining a cast as follows: + +#undef ROUTINE_j +#define ROUTINE_j (cast) +where: + j [1-n], is the argument being specifying. + (cast) is a cast matching that of the argument expected by the C + function protoytpe for which a wrapper is being defined. + +e.g. To create a Fortran wrapper for qsort(3C): +#undef ROUTINE_4 +#define ROUTINE_4 (int (*)(void *,void *)) +FCALLSCSUB4(qsort,FQSORT,fqsort,PVOID,INT,INT,ROUTINE) + +In order to maintain backward compatibility, cfortran.h defines a generic cast +for ROUTINE_1, ROUTINE_2, ..., ROUTINE_27. The user's definition is therefore +strictly required only for DEC C, which at the moment is the only compiler +which insists on the correct cast for pointers to functions. + +When using the ROUTINE argument inside some Fortran code: +- it is difficult to pass a C routine as the parameter, + since in many Fortran implementations, + Fortran has no access to the normal C namespace. + e.g. For most UNIX, + Fortran implicitly only has access to C routines ending in _. + If the calling Fortran code receives the routine as a parameter + it can of course easily pass it along. +- if a Fortran routine is passed directly as the parameter, + the called C routine must call the parameter routine + using the Fortran argument passing conventions. +- if a Fortran routine is to be passed as the parameter, + but if Fortran can be made to pass a C routine as the parameter, + then it may be best to pass a C-callable wrapper for the Fortran routine. + The called C routine is thus spared all Fortran argument passing conventions. + cfortran.h can be used to create such a C-callable wrapper + to the parameter Fortran routine. + +ONLY PowerStationFortran: +This Fortran provides no easy way to pass a Fortran routine as an argument to a +C routine. The problem arises because in Fortran the stack is cleared by the +called routine, while in C/C++ it is cleared by the caller. +The C/C++ stack clearing behavior can be changed to that of Fortran by using +stdcall__ in the function prototype. The stdcall__ cannot be applied in this +case since the called C routine expects the ROUTINE parameter to be a C routine +and does not know that it should apply stdcall__. +In principle the cfortran.h generated Fortran callable wrapper for the called C +routine should be able to massage the ROUTINE argument such that stdcall__ is +performed, but it is not yet known how this could be easily done. + + +8. THE FOLLOWING INSTRUCTIONS ARE NOT REQUIRED FOR VAX VMS + ------------ +(P)STRINGV information [NOT required for VAX VMS]: cfortran.h cannot convert +the FORTRAN vector of STRINGS to the required C vector of STRINGS without +explicitly knowing the number of elements in the vector. The application must +do one of the following for each (P)STRINGV argument in a routine before that +routine's FCALLSCFUNn/SUBn is called: + +#define routine_name_STRV_Ai NUM_ELEMS(j) + or +#define routine_name_STRV_Ai NUM_ELEM_ARG(k) + or +#define routine_name_STRV_Ai TERM_CHARS(l,m) + +where: routine_name is as above. + i [i=1->n.] specifies the argument number of a STRING VECTOR. + j would specify a fixed number of elements. + k [k=1->n. k!=i] would specify an integer argument which specifies the + number of elements. + l [char] the terminating character at the beginning of an + element, indicating to cfortran.h that the preceding + elements in the vector are the valid ones. + m [m=1-...] the number of terminating characters required to appear + at the beginning of the terminating string element. + The terminating element is NOT passed on to + the C routine. + +e.g. #define ce_STRV_A1 TERM_CHARS(' ',2) + FCALLSCSUB1(ce,CE,ce,STRINGV) + +cfortran.h will pass on all elements, in the 1st and only argument to the C +routine ce, of the STRING VECTOR until, but not including, the first string +element beginning with 2 blank, ' ', characters. + + +9. INSTRUCTIONS REQUIRED ONLY FOR FORTRAN COMPILERS WHICH GENERATE + ------------- + ROUTINE NAMES WHICH ARE UNDISTINGUISHABLE FROM C ROUTINE NAMES + i.e. VAX VMS + AbsoftUNIXFortran (AbsoftProFortran ok, since it uses Uppercase names.) + HP9000 if not using the +ppu option of f77 + IBM RS/6000 if not using the -qextname option of xlf + Call them the same_namespace compilers. + +FCALLSCSUBn(...) and FCALLSCFUNn(...), when compiled, are expanded into +'wrapper' functions, so called because they wrap around the original C +functions and interface the format of the original C functions' arguments and +return values with the format of the FORTRAN call. + +Ideally one wants to be able to call the C routine from FORTRAN using the same +name as the original C name. This is not a problem for FORTRAN compilers which +append an underscore, '_', to the names of routines, since the original C +routine has the name 'name', and the FORTRAN wrapper is called 'name_'. +Similarly, if the FORTRAN compiler generates upper case names for routines, the +original C routine 'name' can have a wrapper called 'NAME', [Assuming the C +routine name is not in upper case.] For these compilers, e.g. Mips, CRAY, IBM +RS/6000 'xlf -qextname', HP-UX 'f77 +ppu', the naming of the wrappers is done +automatically. + +For same_namespace compilers things are not as simple, but cfortran.h tries to +provide tools and guidelines to minimize the costs involved in meeting their +constraints. The following two options can provide same_namespace compilers +with distinct names for the wrapper and the original C function. + +These compilers are flagged by cfortran.h with the CF_SAME_NAMESPACE constant, +so that the change in the C name occurs only when required. + +For the remainder of the discussion, routine names generated by FORTRAN +compilers are referred to in lower case, these names should be read as upper +case for the appropriate compilers. + + +HP9000: (When f77 +ppu is not used.) +f77 has a -U option which forces uppercase external names to be generated. +Unfortunately, cc does not handle recursive macros. Hence, if one wished to use +-U for separate C and FORTRAN namespaces, one would have to adopt a different +convention of naming the macros which allow C to call FORTRAN subroutines. +(Functions are not a problem.) The macros are currently the uppercase of the +original FORTRAN name, and would have to be changed to lower case or mixed +case, or to a different name. (Lower case would of course cause conflicts on +many other machines.) Therefore, it is suggested that f77 -U not be used, and +instead that Option a) or Option b) outlined below be used. + + +VAX/VMS: +For the name used by FORTRAN in calling a C routine to be the same as that of +the C routine, the source code of the C routine is required. A preprocessor +directive can then force the C compiler to generate a different name for the C +routine. +e.g. #if defined(vms) + #define name name_ + #endif + void name() {printf("name: was called.\n");} + FCALLSCSUB0(name,NAME,name) + +In the above, the C compiler generates the original routine with the name +'name_' and a wrapper called 'NAME'. This assumes that the name of the routine, +as seen by the C programmer, is not in upper case. The VAX VMS linker is not +case sensitive, allowing cfortran.h to export the upper case name as the +wrapper, which then doesn't conflict with the routine name in C. Since the IBM, +HP and AbsoftUNIXFortran platforms have case sensitive linkers +this technique is not available to them. + +The above technique is required even if the C name is in mixed case, see +Option a) for the other compilers, but is obviously not required when +Option b) is used. + + +Option a) Mixed Case names for the C routines to be called by FORTRAN. + +If the original C routines have mixed case names, there are no name space +conflicts. + +Nevertheless for VAX/VMS, the technique outlined above must also used. + + +Option b) Modifying the names of C routines when used by FORTRAN: + +The more robust naming mechanism, which guarantees portability to all machines, +'renames' C routines when called by FORTRAN. Indeed, one must change the names +on same_namespace compilers when FORTRAN calls C routines for which the source +is unavailable. [Even when the source is available, renaming may be preferable +to Option a) for large libraries of C routines.] + +Obviously, if done for a single type of machine, it must be done for all +machines since the names of routines used in FORTRAN code cannot be easily +redefined for different machines. + +The simplest way to achieve this end is to do explicitly give the modified +FORTRAN name in the FCALLSCSUBn(...) and FCALLSCFUNn(...) declarations. e.g. + +FCALLSCSUB0(name,CFNAME,cfname) + +This allows FORTRAN to call the C routine 'name' as 'cfname'. Any name can of +course be used for a given routine when it is called from FORTRAN, although +this is discouraged due to the confusion it is sure to cause. e.g. Bizarre, +but valid and allowing C's 'call_back' routine to be called from FORTRAN as +'abcd': + +FCALLSCSUB0(call_back,ABCD,abcd) + + +cfortran.h also provides preprocessor directives for a systematic 'renaming' of +the C routines when they are called from FORTRAN. This is done by redefining +the fcallsc macro before the FCALLSCSUB/FUN/n declarations as follows: + +#undef fcallsc +#define fcallsc(UN,LN) preface_fcallsc(CF,cf,UN,LN) + +FCALLSCSUB0(hello,HELLO,hello) + +Will cause C's routine 'hello' to be known in FORTRAN as 'cfhello'. Similarly +all subsequent FCALLSCSUB/FUN/n declarations will generate wrappers to allow +FORTRAN to call C with the C routine's name prefaced by 'cf'. The following has +the same effect, with subsequent FCALLSCSUB/FUN/n's appending the modifier to +the original C routines name. + +#undef fcallsc +#define fcallsc(UN,LN) append_fcallsc(Y,y,UN,LN) + +FCALLSCSUB0(Xroutine,ROUTINE,routine) + +Hence, C's Xroutine is called from FORTRAN as: + CALL XROUTINEY() + +The original behavior of FCALLSCSUB/FUN/n, where FORTRAN routine names are left +identical to those of C, is returned using: + +#undef fcallsc +#define fcallsc(UN,LN) orig_fcallsc(UN,LN) + + +In C, when passing a C routine, i.e. its wrapper, as an argument to a FORTRAN +routine, the FORTRAN name declared is used and the correct fcallsc must be in +effect. E.g. Passing 'name' and 'routine' of the above examples to the FORTRAN +routines, FT1 and FT2, respectively: + +/* This might not be needed if fcallsc is already orig_fcallsc. */ +#undef fcallsc +#define fcallsc(UN,LN) orig_fcallsc(UN,LN) +FT1(C_FUNCTION(CFNAME,cfname)); + +#undef fcallsc +#define fcallsc(UN,LN) append_fcallsc(Y,y,UN,LN) +FT1(C_FUNCTION(XROUTINE,xroutine)); + +If the names of C routines are modified when used by FORTRAN, fcallsc would +usually be defined once in a header_file.h for the application. This definition +would then be used and be valid for the entire application and fcallsc would at +no point need to be redefined. + + +ONCE AGAIN: THE DEFINITIONS, INSTRUCTIONS, DECLARATIONS AND DIFFICULTIES +DESCRIBED HERE, NOTE 9. of II ii), +APPLY ONLY FOR VAX VMS, + IBM RS/6000 WITHOUT THE -qextname OPTION FOR xlf, OR + HP-UX WITHOUT THE +ppu OPTION FOR f77 + AbsoftUNIXFortran +AND APPLY ONLY WHEN CREATING WRAPPERS WHICH ENABLE FORTRAN TO CALL C ROUTINES. + + + +iii) Using C to manipulate FORTRAN COMMON BLOCKS: + ------------------------------------------------------- + +FORTRAN common blocks are set up with the following three constructs: + +1. +#define Common_block_name COMMON_BLOCK(COMMON_BLOCK_NAME,common_block_name) + +Common_block_name is in UPPER CASE. +COMMON_BLOCK_NAME is in UPPER CASE. +common_block_name is in lower case. +[Common_block_name actually follows the same 'rules' as Routine_name in Note 2. + of II i).] This construct exists to ensure that C code accessing the common +block is machine independent. + +2. +COMMON_BLOCK_DEF(TYPEDEF_OF_STRUCT, Common_block_name); + +where +typedef { ... } TYPEDEF_OF_STRUCT; +declares the structure which maps on to the common block. The #define of +Common_block_name must come before the use of COMMON_BLOCK_DEF. + +3. +In exactly one of the C source files, storage should be set aside for the +common block with the definition: + +TYPEDEF_OF_STRUCT Common_block_name; + +The above definition may have to be omitted on some machines for a common block +which is initialized by Fortran BLOCK DATA or is declared with a smaller size +in the C routines than in the Fortran routines. + +The rules for common blocks are not well defined when linking/loading a mixture +of C and Fortran, but the following information may help resolve problems. + +From the 2nd or ANSI ed. of K&R C, p.31, last paragraph: +i) + An external variable must be defined, exactly once, outside of any function; + this sets aside storage for it. +ii) + The variable must also be declared in each function that wants to access it; + ... + The declaration ... may be implicit from context. + +In Fortran, every routine says 'common /bar/ foo', +i.e. part ii) of the above, but there's no part i) requirement. +cc/ld on some machines don't require i) either. +Therefore, when handling Fortran, and sometimes C, +the loader/linker must automagically set aside storage for common blocks. + +Some loaders, including at least one for the CRAY, turn off the +'automagically set aside storage' capability for Fortran common blocks, +if any C object declares that common block. +Therefore, C code should define, i.e. set aside storage, +for the the common block as shown above. + +e.g. +C Fortran + common /fcb/ v,w,x + character *(13) v, w(4), x(3,2) + +/* C */ +typedef struct { char v[13],w[4][13],x[2][3][13]; } FCB_DEF; +#define Fcb COMMON_BLOCK(FCB,fcb) +COMMON_BLOCK_DEF(FCB_DEF,Fcb); +FCB_DEF Fcb; /* Definition, which sets aside storage for Fcb, */ + /* may appear in at most one C source file. */ + + +C programs can place a string (or a multidimensional array of strings) into a +FORTRAN common block using the following call: + +C2FCBSTR( CSTR, FSTR,DIMENSIONS); + +where: + +CSTR is a pointer to the first element of C's copy of the string (array). + The C code must use a duplicate of, not the original, common block string, + because the FORTRAN common block does not allocate space for C strings' + terminating '\0'. + +FSTR is a pointer to the first element of the string (array) in the common + block. + +DIMENSIONS is the number of dimensions of string array. + e.g. char a[10] has DIMENSIONS=0. + char aa[10][17] has DIMENSIONS=1. + etc... + +C2FCBSTR will copy the string (array) from CSTR to FSTR, padding with blanks, +' ', the trailing characters as required. C2FCBSTR uses DIMENSIONS and FSTR to +determine the lengths of the individual string elements and the total number of +elements in the string array. + +Note that: +- the number of string elements in CSTR and FSTR are identical. +- for arrays of strings, the useful lengths of strings in CSTR and FSTR must be + the same. i.e. CSTR elements each have 1 extra character to accommodate the + terminating '\0'. +- On most non-ANSI compilers, the DIMENSION argument cannot be prepended by any + blanks. + + +FCB2CSTR( FSTR, CSTR,DIMENSIONS) + +is the inverse of C2FCBSTR, and shares the same arguments and caveats. +FCB2CSTR copies each string element of FSTR to CSTR, minus FORTRAN strings' +trailing blanks. + + +cfortran.h USERS ARE STRONGLY URGED TO EXAMINE THE COMMON BLOCK EXAMPLES IN +cfortest.c AND cfortex.f. The use of strings in common blocks is +demonstrated, along with a suggested way for C to imitate FORTRAN EQUIVALENCE'd +variables. + + + ===> USERS OF CFORTRAN.H NEED READ NO FURTHER <=== + + +III Some Musings +---------------- + +cfortran.h is simple enough to be used by the most basic of applications, i.e. +making a single C/FORTRAN routine available to the FORTRAN/C programmers. Yet +cfortran.h is powerful enough to easily make entire C/FORTRAN libraries +available to FORTRAN/C programmers. + + +cfortran.h is the ideal tool for FORTRAN libraries which are being (re)written +in C, but are to (continue to) support FORTRAN users. It allows the routines to +be written in 'natural C', without having to consider the FORTRAN argument +passing mechanisms of any machine. It also allows C code accessing these +rewritten routines, to use the C entry point. Without cfortran.h, one risks the +perverse practice of C code calling a C function using FORTRAN argument passing +mechanisms! + + +Perhaps the philosophy and mechanisms of cfortran.h could be used and extended +to create other language bridges such as ADAFORTRAN, CPASCAL, COCCAM, etc. + + +The code generation machinery inside cfortran.h, i.e. the global structure is +quite good, being clean and workable as seen by its ability to meet the needs +and constraints of many different compilers. Though the individual instructions +of the A..., C..., T..., R... and K... tables deserve to be cleaned up. + + + +IV Getting Serious with cfortran.h +----------------------------------- + +cfortran.h is set up to be as simple as possible for the casual user. While +this ease of use will always be present, 'hooks', i.e. preprocessor directives, +are required in cfortran.h so that some of the following 'inefficiencies' can +be eliminated if they cause difficulties: + +o cfortran.h contains a few small routines for string manipulation. These +routines are declared static and are included and compiled in all source code +which uses cfortran.h. Hooks should be provided in cfortran.h to create an +object file of these routines, allowing cfortran.h to merely prototypes +these routines in the application source code. This is the only 'problem' which +afflicts both halves of cfortran.h. The remaining discussion refers to the C +calls FORTRAN half only. + +o Similar to the above routines, cfortran.h generates code for a 'wrapper' +routine for each FUNCTION exported from FORTRAN. Again cfortran.h needs +preprocessor directives to create a single object file of these routines, +and to merely prototype them in the applications. + +o Libraries often contain hundreds of routines. While the preprocessor makes +quick work of generating the required interface code from cfortran.h and the +application.h's, it may be convenient for very large stable libraries to have +final_application.h's which already contain the interface code, i.e. these +final_application.h's would not require cfortran.h. [The convenience can be +imagined for the VAX VMS CC compiler which has a fixed amount of memory for +preprocessor directives. Not requiring cfortran.h, with its hundreds of +directives, could help prevent this compiler from choking on its internal +limits quite so often.] + +With a similar goal in mind, cfortran.h defines 100's of preprocessor +directives. There is always the potential that these will clash with other tags +in the users code, so final_applications.h, which don't require cfortran.h, +also provide the solution. + +In the same vein, routines with more than 14 arguments can not be interfaced by +cfortran.h with compilers which limit C macros to 31 arguments. To resolve this +difficulty, final_application.h's can be created on a compiler without this +limitation. + +Therefore, new machinery is required to do: + +application.h + cfortran.h => final_application.h + +The following example may help clarify the means and ends: + +If the following definition of the HBOOK1 routine, the /*commented_out_part*/, +is passed through the preprocessor [perhaps #undefing and #defining preprocessor +constants if creating an application.h for compiler other than that of the +preprocessor being used, e.g. cpp -Umips -DCRAY ... ] : + +#include "cfortran.h" +PROTOCCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT) +/*#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \*/ + CCALLSFSUB6(HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT, \ + ID,CHTITLE,NX,XMI,XMA,VMX) + +A function prototype is produced by the PROTOCCALLSFSUB6(...). +Interface code is produced, based on the 'variables', +ID,CHTITLE,NX,XMI,XMA,VMX, which will correctly massage a HBOOK1 call. +Therefore, adding the #define line: + +'prototype code' +#define HBOOK1(ID,CHTITLE,NX,XMI,XMA,VMX) \ + 'interface code'(ID,CHTITLE,NX,XMI,XMA,VMX) + +which is placed into final_application.h. + +The only known limitation of the above method does not allow the 'variable' +names to include B1,B2,...,B9,BA,BB,... + +Obviously the machinery to automatically generate final_applications.h from +cfortran.h and applications.h needs more than just some preprocessor +directives, but a fairly simple unix shell script should be sufficient. Any +takers? + + + +V Machine Dependencies of cfortran.h +------------------------------------ + +Porting cfortran.h applications, e.g. the hbook.h and cstring.c mentioned +above, to other machines is trivial since they are machine independent. Porting +cfortran.h requires a solid knowledge of the new machines C preprocessor, and +its FORTRAN argument passing mechanisms. Logically cfortran.h exists as two +halves, a "C CALLS FORTRAN" and a "FORTRAN CALLS C" utility. In some cases it +may be perfectly reasonable to port only 'one half' of cfortran.h onto a new +system. + + +The lucky programmer porting cfortran.h to a new machine, must discover the +FORTRAN argument passing mechanisms. A safe starting point is to assume that +variables and arrays are simply passed by reference, but nothing is guaranteed. +Strings, and n-dimensional arrays of strings are a different story. It is +doubtful that any systems do it quite like VAX VMS does it, so that a UNIX or +f2c versions may provide an easier starting point. + + +cfortran.h uses and abuses the preprocessor's ## operator. Although the ## +operator does not exist in many compilers, many kludges do. cfortran.h uses +/**/ with no space allowed between the slashes, '/', and the macros or tags +to be concatenated. e.g. +#define concat(a,b) a/**/b /* works*/ +main() +{ + concat(pri,ntf)("hello"); /* e.g. */ +} +N.B. On some compilers without ##, /**/ may also not work. The author may be +able to offer alternate kludges. + + + +VI Bugs in vendors C compilers and other curiosities +---------------------------------------------------- + +1. ULTRIX xxxxxx 4.3 1 RISC + +Condolences to long suffering ultrix users! +DEC supplies a working C front end for alpha/OSF, but not for ultrix. + +From K&R ANSI C p. 231: + ultrix> cat cat.c + #define cat(x, y) x ## y + #define xcat(x,y) cat(x,y) + cat(cat(1,2),3) + xcat(xcat(1,2),3) + ultrix> cc -E cat.c + 123 <---- Should be: cat(1,2)3 + 123 <---- Correct. + ultrix> + +The problem for cfortran.h, preventing use of -std and -std1: + ultrix> cat c.c + #define cat(x, y) x ## y + #define xcat(x,y) cat(x,y) + #define AB(X) X+X + #define C(E,F,G) cat(E,F)(G) + #define X(E,F,G) xcat(E,F)(G) + C(A,B,2) + X(A,B,2) + ultrix> cc -std1 -E c.c + 2+2 + AB (2) <---- ????????????? + ultrix> + ultrix> cc -std0 -E c.c + 2+2 + AB(2) <---- ????????????? + ultrix> + +Due to further ultrix preprocessor problems, +for all definitions of definitions with arguments, +cfortran.h >= 3.0 includes the arguments and recommends the same, +even though it is not required by ANSI C. +e.g. Users are advised to do + #define fcallsc(UN,LN) orig_fcallsc(UN,LN) +instead of + #define fcallsc orig_fcallsc +since ultrix fails to properly preprocess the latter example. +CRAY used to (still does?) occasionally trip up on this problem. + + +2. ConvexOS convex C210 11.0 convex + +In a program with a C main, output to LUN=6=* from Fortran goes into +$pwd/fort.6 instead of stdout. Presumably, a magic incantation can be called +from the C main in order to properly initialize the Fortran I/O. + + +3. SunOS 5.3 Generic_101318-69 sun4m sparc + +The default data and code alignments produced by cc, gcc and f77 are compatible. +If deviating from the defaults, consistent alignment options must be used +across all objects compiled by cc and f77. [Does gcc provide such options?] + + +4. SunOS 5.3 Generic_101318-69 sun4m sparc with cc: SC3.0.1 13 Jul 1994 + or equivalently + ULTRIX 4.4 0 RISC using cc -oldc + are K&R C preprocessors that suffer from infinite loop macros, e.g. + + zedy03> cat src.c + #include "cfortran.h" + PROTOCCALLSFFUN1(INT,FREV,frev, INTV) + #define FREV(A1) CCALLSFFUN1( FREV,frev, INTV, A1) + /* To avoid the problem, deletete these ---^^^^--- spaces. */ + main() { static int a[] = {1,2}; FREV(a); return EXIT_SUCCESS; } + + zedy03> cc -c -Xs -v -DMAX_PREPRO_ARGS=31 -D__CF__KnR src.c + "src.c", line 4: FREV: actuals too long + "src.c", line 4: FREV: actuals too long + .... 3427 more lines of the same message + "src.c", line 4: FREV: actuals too long + cc : Fatal error in /usr/ccs/lib/cpp + Segmentation fault (core dumped) + + +5. Older sun C compilers + +To link to f77 objects, older sun C compilers require the math.h macros: + +#define RETURNFLOAT(x) { union {double _d; float _f; } _kluge; \ + _kluge._f = (x); return _kluge._d; } +#define ASSIGNFLOAT(x,y) { union {double _d; float _f; } _kluge; \ + _kluge._d = (y); x = _kluge._f; } + +Unfortunately, in at least some copies of the sun math.h, the semi-colon +for 'float _f;' is left out, leading to compiler warnings. + +The solution is to correct math.h, or to change cfortran.h to #define +RETURNFLOAT(x) and ASSIGNFLOAT(x,y) instead of including math.h. + + +6. gcc version 2.6.3 and probably all other versions as well + +Unlike all other C compilers supported by cfortran.h, +'gcc -traditional' promotes to double all functions returning float +as demonstrated bu the following example. + +/* m.c */ +#include <stdio.h> +int main() { FLOAT_FUNCTION d(); float f; f = d(); printf("%f\n",f); return 0; } + +/* d.c */ +float d() { return -123.124; } + +burow[29] gcc -c -traditional d.c +burow[30] gcc -DFLOAT_FUNCTION=float m.c d.o && a.out +0.000000 +burow[31] gcc -DFLOAT_FUNCTION=double m.c d.o && a.out +-123.124001 +burow[32] + +Thus, 'gcc -traditional' is not supported by cfortran.h. +Support would require the same RETURNFLOAT, etc. macro machinery +present in old sun math.h, before sun gave up the same promotion. + + +7. CRAY + +At least some versions of the t3e and t3d C preprocessor are broken +in the fashion described below. +At least some versions of the t90 C preprocessor do not have this problem. + +On the CRAY, all Fortran names are converted to uppercase. +Generally the uppercase name is also used for the macro interface +created by cfortran.h. + +For example, in the following interface, +EASY is both the name of the macro in the original C code +and EASY is the name of the resulting function to be called. + +#define EASY(A,B) CCALLSFSUB2(EASY,easy, PINT, INTV, A, B) + +The fact that a macro called EASY() expands to a function called EASY() +is not a problem for a working C preprocessor. +From Kernighan and Ritchie, 2nd edition, p.230: + + In both kinds of macro, the replacement token sequence is repeatedly + rescanned for more identifiers. However, once a given identifier has been + replaced in a given expansion, it is not replaced if it turns up again during + rescanning; instead it is left unchanged. + +Unfortunately, some CRAY preprocessors are broken and don't obey the above rule. +A work-around is for the user to NOT use the uppercase name +of the name of the macro interface provided by cfortran.h. For example: + +#define Easy(A,B) CCALLSFSUB2(EASY,easy, PINT, INTV, A, B) + +Luckily, the above work-around is not required since the following +work-around within cfortran.h also circumvents the bug: + + /* (UN), not UN, is required in order to get around CRAY preprocessor bug.*/ + #define CFC_(UN,LN) (UN) /* Uppercase FORTRAN symbols. */ + +Aside: The Visual C++ compiler is happy with UN, but barfs on (UN), + so either (UN) causes nonstandard C/C++ or Visual C++ is broken. + + +VII History and Acknowledgements +-------------------------------- + +1.0 - Supports VAX VMS using C 3.1 and FORTRAN 5.4. Oct. '90. +1.0 - Supports Silicon Graphics w. Mips Computer 2.0 f77 and cc. Feb. '91. + [Port of C calls FORTRAN half only.] +1.1 - Supports Mips Computer System 2.0 f77 and cc. Mar. '91. + [Runs on at least: Silicon Graphics IRIX 3.3.1 + DECstations with Ultrix V4.1] +1.2 - Internals made simpler, smaller, faster, stronger. May '91. + - Mips version works on IBM RS/6000, this is now called the unix version. +1.3 - UNIX and VAX VMS versions are merged into a single cfortran.h. July '91. + - C can help manipulate (arrays of) strings in FORTRAN common blocks. + - Dimensions of string arrays arguments can be explicit. + - Supports Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7. + +2.0 - Improved code generation machinery creates K&R or ANSI C. Aug. '91. + - Supports Sun, CRAY. f2c with vcc on VAX Ultrix. + - cfortran.h macros now require routine and COMMON block names in both + upper and lower case. No changes required to applications though. + - PROTOCCALLSFSUBn is eliminated, with no loss to cfortran.h performance. + - Improved tools and guidelines for naming C routines called by FORTRAN. +2.1 - LOGICAL correctly supported across all machines. Oct. '91. + - Improved support for DOUBLE PRECISION on the CRAY. + - HP9000 fully supported. + - VAX Ultrix cc or gcc with f77 now supported. +2.2 - SHORT, i.e. INTEGER*2, and BYTE now supported. Dec. '91. + - LOGICAL_STRICT introduced. More compact and robust internal tables. + - typeV and typeVV for type = BYTE, DOUBLE, FLOAT, INT, LOGICAL, LONG,SHORT. + - FORTRAN passing strings and NULL pointer to C routines improved. +2.3 - Extraneous arguments removed from many internal tables. May '92. + - Introduce pseudo argument type SIMPLE for user defined types. + - LynxOS using f2c supported. (Tested with LynxOS 2.0 386/AT.) +2.4 - Separation of internal C and Fortran compilation directives. Oct. '92. + - f2c and NAG f90 supported on all machines. +2.5 - Minor mod.s to source and/or doc for HP9000, f2c, and NAG f90. Nov. '92. +2.6 - Support external procedures as arguments with type ROUTINE. Dec. '92. +2.7 - Support Alpha VMS. Support HP9000 f77 +ppu Jan. '93. + - Support arrays with up to 7 dimensions. + - Minor mod. of Fortran NULL to C via (P)STRING. + - Specify the type of ROUTINE passed from Fortran to C [ANSI C requirement.] + - Macros never receive a null parameter [RS/6000 requirement.] +2.8 - PSTRING for Fortran calls C no longer provides escape to pass April'93. + NULL pointer nor to pass address of original string. + PNSTRING introduced with old PSTRING's behavior. + PPSTRING introduced to always pass original address of string. + - Support Alpha/OSF. + - Document that common blocks used in C should be declared AND defined. + +3.0 - Automagic handling of ANSI ## versus K&R /**/ preprocessor op. March'95. + - Less chance of name space collisions between cfortran.h and other codes. + - SIMPLE macros, supporting user defined types, have changed names. +3.1 - Internal macro name _INT not used. Conflicted with IRIX 5.3. May '95. + - SunOS, all versions, should work out of the box. + - ZTRINGV_ARGS|F(k) may no longer point to a PDOUBLE or PFLOAT argument. + - ConvexOS 11.0 supported. +3.2 - __hpux no longer needs to be restricted to MAX_PREPRO_ARGS=31. Oct. '95. + - PSTRING bug fixed. + - ZTRINGV_ARGS|F(k) may not point to a PBYTE,PINT,PLONG or PSHORT argument. + - (P)ZTRINGV machinery improved. Should lead to fewer compiler warnings. + (P)ZTRINGV no longer limits recursion or the nesting of routines. + - SIMPLE macros, supporting user defined types, have changed slightly. +3.3 - Supports PowerStation Fortran with Visual C++. Nov. '95. + - g77 should work using f2cFortran, though no changes made for it. + - (PROTO)CCALLSFFUN10 extended to (PROTO)CCALLSFFUN14. + - FCALLSCFUN10 and SUB10 extended to FCALLSCFUN14 and SUB14. +3.4 - C++ supported, Dec. '95. + but it required the reintroduction of PROTOCCALLSFSUBn for users. + - HP-UX f77 +800 supported. +3.5 - Absoft UNIX Fortran supported. Sept.'96. +3.6 - Minor corrections to cfortran.doc. Oct. '96. + - Fixed bug for 15th argument. [Thanks to Tom Epperly at Aspen Tech.] + - For AbsoftUNIXFortran, obey default of prepending _C to COMMON BLOCK name. + - Fortran calling C with ROUTINE argument fixed and cleaned up. +3.7 - Circumvent IBM and HP "null argument" preprocessor warning. Oct. '96 +3.8 - (P)STRINGV and (P)ZTRINGV can pass a 1- or 2-dim. char array. Feb. '97 + (P)ZTRINGV thus effectively also provides (P)ZTRING. + - (P)ZTRINGV accepts a (char *) pointer. +3.9 - Bug fixed for *VVVVV. May '97 + - f2c: Work-around for strange underscore-dependent naming feature. + - NEC SX-4 supported. + - CRAY: LOGICAL conversion uses _btol and _ltob from CRAY's fortran.h. + - CRAY: Avoid bug of some versions of the C preprocessor. + - CRAY T3E: FORTRAN_REAL introduced. + +4.0 - new/delete now used for C++. malloc/free still used for C. Jan. '98 + - FALSE no longer is defined by cfortran.h . + - Absoft Pro Fortran for MacOS supported. +4.1 - COMMA and COLON no longer are defined by cfortran.h . April'98 + - Bug fixed when 10th arg. or beyond is a string. + [Rob Lucchesi of NASA-Goddard pointed out this bug.] + - CCALLSFSUB/FUN extended from 14 to 27 arguments. + - Workaround SunOS CC 4.2 cast bug. [Thanks to Savrak SAR of CERN.] +4.2 - Portland Group needs -DpgiFortran . [Thank George Lai of NASA.] June '98 +4.3 - (PROTO)CCALLSFSUB extended from 20 to 27 arguments. July '98 + + +['Support' implies these and more recent releases of the respective + OS/compilers/linkers can be used with cfortran.h. + Earlier releases may also work.] + + +Acknowledgements: +- CERN very generously sponsored a week in 1994 for me to work on cfortran.h. +- M.L.Luvisetto (Istituto Nazionale Fisica Nucleare - Centro Nazionale + Analisi Fotogrammi, Bologna, Italy) provided all the support for the port to + the CRAY. Marisa's encouragement and enthusiasm was also much appreciated. +- J.Bunn (CERN) supported the port to PowerStation Fortran with Visual C++. +- Paul Schenk (UC Riverside, CERN PPE/OPAL) in June 1993 extended cfortran.h 2.7 + to have C++ call Fortran. This was the starting point for full C++ in 3.4. +- Glenn P.Davis of University Corp. for Atmospheric Research (UCAR) / Unidata + supported the NEC SX-4 port and helped understand the CRAY. +- Tony Goelz of Absoft Corporation ported cfortran.h to Absoft. +- Though cfortran.h has been created in my 'copious' free time, I thank + NSERC for their generous support of my grad. student and postdoc years. +- Univ.Toronto, DESY, CERN and others have provided time on their computers. + + +THIS PACKAGE, I.E. CFORTRAN.H, THIS DOCUMENT, AND THE CFORTRAN.H EXAMPLE +PROGRAMS ARE PROPERTY OF THE AUTHOR WHO RESERVES ALL RIGHTS. THIS PACKAGE AND +THE CODE IT PRODUCES MAY BE FREELY DISTRIBUTED WITHOUT FEES, SUBJECT TO THE +FOLLOWING RESTRICTIONS: +- YOU MUST ACCOMPANY ANY COPIES OR DISTRIBUTION WITH THIS (UNALTERED) NOTICE. +- YOU MAY NOT RECEIVE MONEY FOR THE DISTRIBUTION OR FOR ITS MEDIA + (E.G. TAPE, DISK, COMPUTER, PAPER.) +- YOU MAY NOT PREVENT OTHERS FROM COPYING IT FREELY. +- YOU MAY NOT DISTRIBUTE MODIFIED VERSIONS WITHOUT CLEARLY DOCUMENTING YOUR + CHANGES AND NOTIFYING THE AUTHOR. +- YOU MAY NOT MISREPRESENTED THE ORIGIN OF THIS SOFTWARE, EITHER BY EXPLICIT + CLAIM OR BY OMISSION. + +THE INTENT OF THE ABOVE TERMS IS TO ENSURE THAT THE CFORTRAN.H PACKAGE NOT BE +USED FOR PROFIT MAKING ACTIVITIES UNLESS SOME ROYALTY ARRANGEMENT IS ENTERED +INTO WITH ITS AUTHOR. + +THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER +EXPRESSED OR IMPLIED. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST +OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. THE AUTHOR IS NOT RESPONSIBLE +FOR ANY SUPPORT OR SERVICE OF THE CFORTRAN.H PACKAGE. + + Burkhard Burow + burow@desy.de + +P.S. Your comments and questions are welcomed and usually promptly answered. + +VAX VMS and Ultrix, Alpha, OSF, Silicon Graphics (SGI), DECstation, Mips RISC, +Sun, CRAY, Convex, IBM RS/6000, Apollo DomainOS, HP, LynxOS, f2c, NAG, Absoft, +NEC SX-4, PowerStation and Visual C++ are registered trademarks of their +respective owners. + +/* end: cfortran.doc */ diff --git a/src/include/cfortran.h b/src/include/cfortran.h new file mode 100644 index 0000000..ed23011 --- /dev/null +++ b/src/include/cfortran.h @@ -0,0 +1,2363 @@ +/* cfortran.h 4.3 */ +/* http://www-zeus.desy.de/~burow/cfortran/ */ +/* Burkhard Burow burow@desy.de 1990 - 2001. */ + +#ifndef __CFORTRAN_LOADED +#define __CFORTRAN_LOADED + +/* + THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU + SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING, + MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE. +*/ + +/* + Avoid symbols already used by compilers and system *.h: + __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c + + */ + + +/* First prepare for the C compiler. */ + +#ifndef ANSI_C_preprocessor /* i.e. user can override. */ +#ifdef __CF__KnR +#define ANSI_C_preprocessor 0 +#else +#ifdef __STDC__ +#define ANSI_C_preprocessor 1 +#else +#define _cfleft 1 +#define _cfright +#define _cfleft_cfright 0 +#define ANSI_C_preprocessor _cfleft/**/_cfright +#endif +#endif +#endif + +#if ANSI_C_preprocessor +#define _0(A,B) A##B +#define _(A,B) _0(A,B) /* see cat,xcat of K&R ANSI C p. 231 */ +#define _2(A,B) A##B /* K&R ANSI C p.230: .. identifier is not replaced */ +#define _3(A,B,C) _(A,_(B,C)) +#else /* if it turns up again during rescanning. */ +#define _(A,B) A/**/B +#define _2(A,B) A/**/B +#define _3(A,B,C) A/**/B/**/C +#endif + +#if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__)) +#define VAXUltrix +#endif + +#include <stdio.h> /* NULL [in all machines stdio.h] */ +#include <string.h> /* strlen, memset, memcpy, memchr. */ +#if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) ) +#include <stdlib.h> /* malloc,free */ +#else +#include <malloc.h> /* Had to be removed for DomainOS h105 10.4 sys5.3 425t*/ +#ifdef apollo +#define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */ +#endif +#endif + +#if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx)) +#define __CF__KnR /* Sun, LynxOS and VAX Ultrix cc only supports K&R. */ + /* Manually define __CF__KnR for HP if desired/required.*/ +#endif /* i.e. We will generate Kernighan and Ritchie C. */ +/* Note that you may define __CF__KnR before #include cfortran.h, in order to +generate K&R C instead of the default ANSI C. The differences are mainly in the +function prototypes and declarations. All machines, except the Apollo, work +with either style. The Apollo's argument promotion rules require ANSI or use of +the obsolete std_$call which we have not implemented here. Hence on the Apollo, +only C calling FORTRAN subroutines will work using K&R style.*/ + + +/* Remainder of cfortran.h depends on the Fortran compiler. */ + +#if defined(CLIPPERFortran) || defined(pgiFortran) +#define f2cFortran +#endif + +/* VAX/VMS does not let us \-split long #if lines. */ +/* Split #if into 2 because some HP-UX can't handle long #if */ +#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)) +#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran)) +/* If no Fortran compiler is given, we choose one for the machines we know. */ +#if defined(lynx) || defined(VAXUltrix) +#define f2cFortran /* Lynx: Only support f2c at the moment. + VAXUltrix: f77 behaves like f2c. + Support f2c or f77 with gcc, vcc with f2c. + f77 with vcc works, missing link magic for f77 I/O.*/ +#endif +#if defined(__hpux) /* 921107: Use __hpux instead of __hp9000s300 */ +#define hpuxFortran /* Should also allow hp9000s7/800 use.*/ +#endif +#if defined(apollo) +#define apolloFortran /* __CF__APOLLO67 also defines some behavior. */ +#endif +#if defined(sun) || defined(__sun) +#define sunFortran +#endif +#if defined(_IBMR2) +#define IBMR2Fortran +#endif +#if defined(_CRAY) +#define CRAYFortran /* _CRAYT3E also defines some behavior. */ +#endif +#if defined(_SX) +#define SXFortran +#endif +#if defined(mips) || defined(__mips) +#define mipsFortran +#endif +#if defined(vms) || defined(__vms) +#define vmsFortran +#endif +#if defined(__alpha) && defined(__unix__) +#define DECFortran +#endif +#if defined(__convex__) +#define CONVEXFortran +#endif +#if defined(VISUAL_CPLUSPLUS) +#define PowerStationFortran +#endif +#endif /* ...Fortran */ +#endif /* ...Fortran */ + +/* Split #if into 2 because some HP-UX can't handle long #if */ +#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)) +#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran)) +/* If your compiler barfs on ' #error', replace # with the trigraph for # */ + #error "cfortran.h: Can't find your environment among:\ + - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...) \ + - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000 \ + - VAX VMS CC 3.1 and FORTRAN 5.4. \ + - Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0. \ + - Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2 \ + - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7. \ + - CRAY \ + - NEC SX-4 SUPER-UX \ + - CONVEX \ + - Sun \ + - PowerStation Fortran with Visual C++ \ + - HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730 \ + - LynxOS: cc or gcc with f2c. \ + - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77. \ + - f77 with vcc works; but missing link magic for f77 I/O. \ + - NO fort. None of gcc, cc or vcc generate required names.\ + - f2c : Use #define f2cFortran, or cc -Df2cFortran \ + - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran \ + - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran \ + - Absoft Pro Fortran: Use #define AbsoftProFortran \ + - Portland Group Fortran: Use #define pgiFortran" +/* Compiler must throw us out at this point! */ +#endif +#endif + + +#if defined(VAXC) && !defined(__VAXC) +#define OLD_VAXC +#pragma nostandard /* Prevent %CC-I-PARAMNOTUSED. */ +#endif + +/* Throughout cfortran.h we use: UN = Uppercase Name. LN = Lowercase Name. */ + +#if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(extname) +#define CFC_(UN,LN) _(LN,_) /* Lowercase FORTRAN symbols. */ +#define orig_fcallsc(UN,LN) CFC_(UN,LN) +#else +#if defined(CRAYFortran) || defined(PowerStationFortran) || defined(AbsoftProFortran) +#ifdef _CRAY /* (UN), not UN, circumvents CRAY preprocessor bug. */ +#define CFC_(UN,LN) (UN) /* Uppercase FORTRAN symbols. */ +#else /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */ +#define CFC_(UN,LN) UN /* Uppercase FORTRAN symbols. */ +#endif +#define orig_fcallsc(UN,LN) CFC_(UN,LN) /* CRAY insists on arg.'s here. */ +#else /* For following machines one may wish to change the fcallsc default. */ +#define CF_SAME_NAMESPACE +#ifdef vmsFortran +#define CFC_(UN,LN) LN /* Either case FORTRAN symbols. */ + /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/ + /* because VAX/VMS doesn't do recursive macros. */ +#define orig_fcallsc(UN,LN) UN +#else /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */ +#define CFC_(UN,LN) LN /* Lowercase FORTRAN symbols. */ +#define orig_fcallsc(UN,LN) CFC_(UN,LN) +#endif /* vmsFortran */ +#endif /* CRAYFortran PowerStationFortran */ +#endif /* ....Fortran */ + +#define fcallsc(UN,LN) orig_fcallsc(UN,LN) +#define preface_fcallsc(P,p,UN,LN) CFC_(_(P,UN),_(p,LN)) +#define append_fcallsc(P,p,UN,LN) CFC_(_(UN,P),_(LN,p)) + +#define C_FUNCTION(UN,LN) fcallsc(UN,LN) +#define FORTRAN_FUNCTION(UN,LN) CFC_(UN,LN) + +#ifndef COMMON_BLOCK +#ifndef CONVEXFortran +#ifndef CLIPPERFortran +#if !(defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)) +#define COMMON_BLOCK(UN,LN) CFC_(UN,LN) +#else +#define COMMON_BLOCK(UN,LN) _(_C,LN) +#endif /* AbsoftUNIXFortran or AbsoftProFortran */ +#else +#define COMMON_BLOCK(UN,LN) _(LN,__) +#endif /* CLIPPERFortran */ +#else +#define COMMON_BLOCK(UN,LN) _3(_,LN,_) +#endif /* CONVEXFortran */ +#endif /* COMMON_BLOCK */ + +#ifndef DOUBLE_PRECISION +#if defined(CRAYFortran) && !defined(_CRAYT3E) +#define DOUBLE_PRECISION long double +#else +#define DOUBLE_PRECISION double +#endif +#endif + +#ifndef FORTRAN_REAL +#if defined(CRAYFortran) && defined(_CRAYT3E) +#define FORTRAN_REAL double +#else +#define FORTRAN_REAL float +#endif +#endif + +#ifdef CRAYFortran +#ifdef _CRAY +#include <fortran.h> +#else +#include "fortran.h" /* i.e. if crosscompiling assume user has file. */ +#endif +#define FLOATVVVVVVV_cfPP (FORTRAN_REAL *) /* Used for C calls FORTRAN. */ +/* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/ +#define VOIDP (void *) /* When FORTRAN calls C, we don't know if C routine + arg.'s have been declared float *, or double *. */ +#else +#define FLOATVVVVVVV_cfPP +#define VOIDP +#endif + +#ifdef vmsFortran +#if defined(vms) || defined(__vms) +#include <descrip.h> +#else +#include "descrip.h" /* i.e. if crosscompiling assume user has file. */ +#endif +#endif + +#ifdef sunFortran +#if defined(sun) || defined(__sun) +#include <math.h> /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT. */ +#else +#include "math.h" /* i.e. if crosscompiling assume user has file. */ +#endif +/* At least starting with the default C compiler SC3.0.1 of SunOS 5.3, + * FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in + * <math.h>, since sun C no longer promotes C float return values to doubles. + * Therefore, only use them if defined. + * Even if gcc is being used, assume that it exhibits the Sun C compiler + * behavior in order to be able to use *.o from the Sun C compiler. + * i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc. + */ +#endif + +#ifndef apolloFortran +#define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME +#define CF_NULL_PROTO +#else /* HP doesn't understand #elif. */ +/* Without ANSI prototyping, Apollo promotes float functions to double. */ +/* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */ +#define CF_NULL_PROTO ... +#ifndef __CF__APOLLO67 +#define COMMON_BLOCK_DEF(DEFINITION, NAME) \ + DEFINITION NAME __attribute((__section(NAME))) +#else +#define COMMON_BLOCK_DEF(DEFINITION, NAME) \ + DEFINITION NAME #attribute[section(NAME)] +#endif +#endif + +#ifdef __cplusplus +#undef CF_NULL_PROTO +#define CF_NULL_PROTO ... +#endif + + +#ifndef USE_NEW_DELETE +#ifdef __cplusplus +#define USE_NEW_DELETE 1 +#else +#define USE_NEW_DELETE 0 +#endif +#endif +#if USE_NEW_DELETE +#define _cf_malloc(N) new char[N] +#define _cf_free(P) delete[] P +#else +#define _cf_malloc(N) (char *)malloc(N) +#define _cf_free(P) free(P) +#endif + +#ifdef mipsFortran +#define CF_DECLARE_GETARG int f77argc; char **f77argv +#define CF_SET_GETARG(ARGC,ARGV) f77argc = ARGC; f77argv = ARGV +#else +#define CF_DECLARE_GETARG +#define CF_SET_GETARG(ARGC,ARGV) +#endif + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define AcfCOMMA , +#define AcfCOLON ; + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES USED WITHIN CFORTRAN.H */ + +#define _cfMIN(A,B) (A<B?A:B) + +/* 970211 - XIX.145: + firstindexlength - better name is all_but_last_index_lengths + secondindexlength - better name is last_index_length + */ +#define firstindexlength(A) (sizeof(A[0])==1 ? 1 : (sizeof(A) / sizeof(A[0])) ) +#define secondindexlength(A) (sizeof(A[0])==1 ? sizeof(A) : sizeof(A[0]) ) + +/* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int. +Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV. +f2c, MIPS f77 [DECstation, SGI], VAX Ultrix f77, +HP-UX f77 : as in C. +VAX/VMS FORTRAN, VAX Ultrix fort, +Absoft Unix Fortran, IBM RS/6000 xlf : LS Bit = 0/1 = TRUE/FALSE. +Apollo : neg. = TRUE, else FALSE. +[Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.] +[DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.] +[MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/ + +#if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran) || defined(PowerStationFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) || defined(SXFortran) +/* SX/PowerStationFortran have 0 and 1 defined, others are neither T nor F. */ +/* hpuxFortran800 has 0 and 0x01000000 defined. Others are unknown. */ +#define LOGICAL_STRICT /* Other Fortran have .eqv./.neqv. == .eq./.ne. */ +#endif + +#define C2FLOGICALV(A,I) \ + do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (0) +#define F2CLOGICALV(A,I) \ + do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (0) + +#if defined(apolloFortran) +#define C2FLOGICAL(L) ((L)?-1:(L)&~((unsigned)1<<sizeof(int)*8-1)) +#define F2CLOGICAL(L) ((L)<0?(L):0) +#else +#if defined(CRAYFortran) +#define C2FLOGICAL(L) _btol(L) +#define F2CLOGICAL(L) _ltob(&(L)) /* Strangely _ltob() expects a pointer. */ +#else +#if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran) || defined(AbsoftUNIXFortran) +/* How come no AbsoftProFortran ? */ +#define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1) +#define F2CLOGICAL(L) ((L)&1?(L):0) +#else +#if defined(CONVEXFortran) +#define C2FLOGICAL(L) ((L) ? ~0 : 0 ) +#define F2CLOGICAL(L) (L) +#else /* others evaluate LOGICALs as for C. */ +#define C2FLOGICAL(L) (L) +#define F2CLOGICAL(L) (L) +#ifndef LOGICAL_STRICT +#undef C2FLOGICALV +#undef F2CLOGICALV +#define C2FLOGICALV(A,I) +#define F2CLOGICALV(A,I) +#endif /* LOGICAL_STRICT */ +#endif /* CONVEXFortran || All Others */ +#endif /* IBMR2Fortran vmsFortran DECFortran AbsoftUNIXFortran */ +#endif /* CRAYFortran */ +#endif /* apolloFortran */ + +/* 970514 - In addition to CRAY, there may be other machines + for which LOGICAL_STRICT makes no sense. */ +#if defined(LOGICAL_STRICT) && !defined(CRAYFortran) +/* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE. + SX/PowerStationFortran only have 0 and 1 defined. + Elsewhere, only needed if you want to do: + logical lvariable + if (lvariable .eq. .true.) then ! (1) + instead of + if (lvariable .eqv. .true.) then ! (2) + - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf + refuse to compile (1), so you are probably well advised to stay away from + (1) and from LOGICAL_STRICT. + - You pay a (slight) performance penalty for using LOGICAL_STRICT. */ +#undef C2FLOGICAL +#ifdef hpuxFortran800 +#define C2FLOGICAL(L) ((L)?0x01000000:0) +#else +#if defined(apolloFortran) || defined(vmsFortran) || defined(DECFortran) +#define C2FLOGICAL(L) ((L)?-1:0) /* These machines use -1/0 for .true./.false.*/ +#else +#define C2FLOGICAL(L) ((L)? 1:0) /* All others use +1/0 for .true./.false.*/ +#endif +#endif +#endif /* LOGICAL_STRICT */ + +/* Convert a vector of C strings into FORTRAN strings. */ +#ifndef __CF__KnR +static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr) +#else +static char *c2fstrv( cstr, fstr, elem_len, sizeofcstr) + char* cstr; char *fstr; int elem_len; int sizeofcstr; +#endif +{ int i,j; +/* elem_len includes \0 for C strings. Fortran strings don't have term. \0. + Useful size of string must be the same in both languages. */ +for (i=0; i<sizeofcstr/elem_len; i++) { + for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++; + cstr += 1+elem_len-j; + for (; j<elem_len; j++) *fstr++ = ' '; +} /* 95109 - Seems to be returning the original fstr. */ +return fstr-sizeofcstr+sizeofcstr/elem_len; } + +/* Convert a vector of FORTRAN strings into C strings. */ +#ifndef __CF__KnR +static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr) +#else +static char *f2cstrv( fstr, cstr, elem_len, sizeofcstr) + char *fstr; char* cstr; int elem_len; int sizeofcstr; +#endif +{ int i,j; +/* elem_len includes \0 for C strings. Fortran strings don't have term. \0. + Useful size of string must be the same in both languages. */ +cstr += sizeofcstr; +fstr += sizeofcstr - sizeofcstr/elem_len; +for (i=0; i<sizeofcstr/elem_len; i++) { + *--cstr = '\0'; + for (j=1; j<elem_len; j++) *--cstr = *--fstr; +} return cstr; } + +/* kill the trailing char t's in string s. */ +#ifndef __CF__KnR +static char *kill_trailing(char *s, char t) +#else +static char *kill_trailing( s, t) char *s; char t; +#endif +{char *e; +e = s + strlen(s); +if (e>s) { /* Need this to handle NULL string.*/ + while (e>s && *--e==t); /* Don't follow t's past beginning. */ + e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */ +} return s; } + +/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally +points to the terminating '\0' of s, but may actually point to anywhere in s. +s's new '\0' will be placed at e or earlier in order to remove any trailing t's. +If e<s string s is left unchanged. */ +#ifndef __CF__KnR +static char *kill_trailingn(char *s, char t, char *e) +#else +static char *kill_trailingn( s, t, e) char *s; char t; char *e; +#endif +{ +if (e==s) *e = '\0'; /* Kill the string makes sense here.*/ +else if (e>s) { /* Watch out for neg. length string.*/ + while (e>s && *--e==t); /* Don't follow t's past beginning. */ + e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */ +} return s; } + +/* Note the following assumes that any element which has t's to be chopped off, +does indeed fill the entire element. */ +#ifndef __CF__KnR +static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t) +#else +static char *vkill_trailing( cstr, elem_len, sizeofcstr, t) + char* cstr; int elem_len; int sizeofcstr; char t; +#endif +{ int i; +for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */ + kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1); +return cstr; } + +#ifdef vmsFortran +typedef struct dsc$descriptor_s fstring; +#define DSC$DESCRIPTOR_A(DIMCT) \ +struct { \ + unsigned short dsc$w_length; unsigned char dsc$b_dtype; \ + unsigned char dsc$b_class; char *dsc$a_pointer; \ + char dsc$b_scale; unsigned char dsc$b_digits; \ + struct { \ + unsigned : 3; unsigned dsc$v_fl_binscale : 1; \ + unsigned dsc$v_fl_redim : 1; unsigned dsc$v_fl_column : 1; \ + unsigned dsc$v_fl_coeff : 1; unsigned dsc$v_fl_bounds : 1; \ + } dsc$b_aflags; \ + unsigned char dsc$b_dimct; unsigned long dsc$l_arsize; \ + char *dsc$a_a0; long dsc$l_m [DIMCT]; \ + struct { \ + long dsc$l_l; long dsc$l_u; \ + } dsc$bounds [DIMCT]; \ +} +typedef DSC$DESCRIPTOR_A(1) fstringvector; +/*typedef DSC$DESCRIPTOR_A(2) fstringarrarr; + typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/ +#define initfstr(F,C,ELEMNO,ELEMLEN) \ +( (F).dsc$l_arsize= ( (F).dsc$w_length =(ELEMLEN) ) \ + *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO) ), \ + (F).dsc$a_a0 = ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length ,(F)) + +#else +#define _NUM_ELEMS -1 +#define _NUM_ELEM_ARG -2 +#define NUM_ELEMS(A) A,_NUM_ELEMS +#define NUM_ELEM_ARG(B) *_2(A,B),_NUM_ELEM_ARG +#define TERM_CHARS(A,B) A,B +#ifndef __CF__KnR +static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term) +#else +static int num_elem( strv, elem_len, term_char, num_term) + char *strv; unsigned elem_len; int term_char; int num_term; +#endif +/* elem_len is the number of characters in each element of strv, the FORTRAN +vector of strings. The last element of the vector must begin with at least +num_term term_char characters, so that this routine can determine how +many elements are in the vector. */ +{ +unsigned num,i; +if (num_term == _NUM_ELEMS || num_term == _NUM_ELEM_ARG) + return term_char; +if (num_term <=0) num_term = (int)elem_len; +for (num=0; ; num++) { + for (i=0; i<(unsigned)num_term && *strv==term_char; i++,strv++); + if (i==(unsigned)num_term) break; + else strv += elem_len-i; +} +return (int)num; +} +#endif +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS */ + +/* C string TO Fortran Common Block STRing. */ +/* DIM is the number of DIMensions of the array in terms of strings, not + characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */ +#define C2FCBSTR(CSTR,FSTR,DIM) \ + c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \ + sizeof(FSTR)+cfelementsof(FSTR,DIM)) + +/* Fortran Common Block string TO C STRing. */ +#define FCB2CSTR(FSTR,CSTR,DIM) \ + vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR, \ + sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \ + sizeof(FSTR)+cfelementsof(FSTR,DIM)), \ + sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \ + sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ') + +#define cfDEREFERENCE0 +#define cfDEREFERENCE1 * +#define cfDEREFERENCE2 ** +#define cfDEREFERENCE3 *** +#define cfDEREFERENCE4 **** +#define cfDEREFERENCE5 ***** +#define cfelementsof(A,D) (sizeof(A)/sizeof(_(cfDEREFERENCE,D)(A))) + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR C TO CALL FORTRAN SUBROUTINES */ + +/* Define lookup tables for how to handle the various types of variables. */ + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#define ZTRINGV_NUM(I) I +#define ZTRINGV_ARGFP(I) (*(_2(A,I))) /* Undocumented. For PINT, etc. */ +#define ZTRINGV_ARGF(I) _2(A,I) +#ifdef CFSUBASFUN +#define ZTRINGV_ARGS(I) ZTRINGV_ARGF(I) +#else +#define ZTRINGV_ARGS(I) _2(B,I) +#endif + +#define PBYTE_cfVP(A,B) PINT_cfVP(A,B) +#define PDOUBLE_cfVP(A,B) +#define PFLOAT_cfVP(A,B) +#ifdef ZTRINGV_ARGS_allows_Pvariables +/* This allows Pvariables for ARGS. ARGF machinery is above ARGFP. + * B is not needed because the variable may be changed by the Fortran routine, + * but because B is the only way to access an arbitrary macro argument. */ +#define PINT_cfVP(A,B) int B = (int)A; /* For ZSTRINGV_ARGS */ +#else +#define PINT_cfVP(A,B) +#endif +#define PLOGICAL_cfVP(A,B) int *B; /* Returning LOGICAL in FUNn and SUBn */ +#define PLONG_cfVP(A,B) PINT_cfVP(A,B) +#define PSHORT_cfVP(A,B) PINT_cfVP(A,B) + +#define VCF_INT_S(T,A,B) _(T,VVVVVVV_cfTYPE) B = A; +#define VCF_INT_F(T,A,B) _(T,_cfVCF)(A,B) +/* _cfVCF table is directly mapped to _cfCCC table. */ +#define BYTE_cfVCF(A,B) +#define DOUBLE_cfVCF(A,B) +#if !defined(__CF__KnR) +#define FLOAT_cfVCF(A,B) +#else +#define FLOAT_cfVCF(A,B) FORTRAN_REAL B = A; +#endif +#define INT_cfVCF(A,B) +#define LOGICAL_cfVCF(A,B) +#define LONG_cfVCF(A,B) +#define SHORT_cfVCF(A,B) + +/* 980416 + Cast (void (*)(CF_NULL_PROTO)) causes SunOS CC 4.2 occasionally to barf, + while the following equivalent typedef is fine. + For consistency use the typedef on all machines. + */ +typedef void (*cfCAST_FUNCTION)(CF_NULL_PROTO); + +#define VCF(TN,I) _Icf4(4,V,TN,_(A,I),_(B,I),F) +#define VVCF(TN,AI,BI) _Icf4(4,V,TN,AI,BI,S) +#define INT_cfV(T,A,B,F) _(VCF_INT_,F)(T,A,B) +#define INTV_cfV(T,A,B,F) +#define INTVV_cfV(T,A,B,F) +#define INTVVV_cfV(T,A,B,F) +#define INTVVVV_cfV(T,A,B,F) +#define INTVVVVV_cfV(T,A,B,F) +#define INTVVVVVV_cfV(T,A,B,F) +#define INTVVVVVVV_cfV(T,A,B,F) +#define PINT_cfV( T,A,B,F) _(T,_cfVP)(A,B) +#define PVOID_cfV( T,A,B,F) +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) +#define ROUTINE_cfV(T,A,B,F) void (*B)(CF_NULL_PROTO) = (cfCAST_FUNCTION)A; +#else +#define ROUTINE_cfV(T,A,B,F) +#endif +#define SIMPLE_cfV(T,A,B,F) +#ifdef vmsFortran +#define STRING_cfV(T,A,B,F) static struct {fstring f; unsigned clen;} B = \ + {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0}; +#define PSTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL}; +#define STRINGV_cfV(T,A,B,F) static fstringvector B = \ + {sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}}; +#define PSTRINGV_cfV(T,A,B,F) static fstringvector B = \ + {0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}}; +#else +#define STRING_cfV(T,A,B,F) struct {unsigned int clen, flen;} B; +#define STRINGV_cfV(T,A,B,F) struct {char *s, *fs; unsigned flen;} B; +#define PSTRING_cfV(T,A,B,F) int B; +#define PSTRINGV_cfV(T,A,B,F) struct{char *fs; unsigned int sizeofA,flen;}B; +#endif +#define ZTRINGV_cfV(T,A,B,F) STRINGV_cfV(T,A,B,F) +#define PZTRINGV_cfV(T,A,B,F) PSTRINGV_cfV(T,A,B,F) + +/* Note that the actions of the A table were performed inside the AA table. + VAX Ultrix vcc, and HP-UX cc, didn't evaluate arguments to functions left to + right, so we had to split the original table into the current robust two. */ +#define ACF(NAME,TN,AI,I) _(TN,_cfSTR)(4,A,NAME,I,AI,_(B,I),0) +#define DEFAULT_cfA(M,I,A,B) +#define LOGICAL_cfA(M,I,A,B) B=C2FLOGICAL(B); +#define PLOGICAL_cfA(M,I,A,B) A=C2FLOGICAL(A); +#define STRING_cfA(M,I,A,B) STRING_cfC(M,I,A,B,sizeof(A)) +#define PSTRING_cfA(M,I,A,B) PSTRING_cfC(M,I,A,B,sizeof(A)) +#ifdef vmsFortran +#define AATRINGV_cfA( A,B, sA,filA,silA) \ + initfstr(B,_cf_malloc((sA)-(filA)),(filA),(silA)-1), \ + c2fstrv(A,B.dsc$a_pointer,(silA),(sA)); +#define APATRINGV_cfA( A,B, sA,filA,silA) \ + initfstr(B,A,(filA),(silA)-1),c2fstrv(A,A,(silA),(sA)); +#else +#define AATRINGV_cfA( A,B, sA,filA,silA) \ + (B.s=_cf_malloc((sA)-(filA)),B.fs=c2fstrv(A,B.s,(B.flen=(silA)-1)+1,(sA))); +#define APATRINGV_cfA( A,B, sA,filA,silA) \ + B.fs=c2fstrv(A,A,(B.flen=(silA)-1)+1,B.sizeofA=(sA)); +#endif +#define STRINGV_cfA(M,I,A,B) \ + AATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A)) +#define PSTRINGV_cfA(M,I,A,B) \ + APATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A)) +#define ZTRINGV_cfA(M,I,A,B) AATRINGV_cfA( (char *)A,B, \ + (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1) +#define PZTRINGV_cfA(M,I,A,B) APATRINGV_cfA( (char *)A,B, \ + (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1) + +#define PBYTE_cfAAP(A,B) &A +#define PDOUBLE_cfAAP(A,B) &A +#define PFLOAT_cfAAP(A,B) FLOATVVVVVVV_cfPP &A +#define PINT_cfAAP(A,B) &A +#define PLOGICAL_cfAAP(A,B) B= &A /* B used to keep a common W table. */ +#define PLONG_cfAAP(A,B) &A +#define PSHORT_cfAAP(A,B) &A + +#define AACF(TN,AI,I,C) _SEP_(TN,C,cfCOMMA) _Icf(3,AA,TN,AI,_(B,I)) +#define INT_cfAA(T,A,B) &B +#define INTV_cfAA(T,A,B) _(T,VVVVVV_cfPP) A +#define INTVV_cfAA(T,A,B) _(T,VVVVV_cfPP) A[0] +#define INTVVV_cfAA(T,A,B) _(T,VVVV_cfPP) A[0][0] +#define INTVVVV_cfAA(T,A,B) _(T,VVV_cfPP) A[0][0][0] +#define INTVVVVV_cfAA(T,A,B) _(T,VV_cfPP) A[0][0][0][0] +#define INTVVVVVV_cfAA(T,A,B) _(T,V_cfPP) A[0][0][0][0][0] +#define INTVVVVVVV_cfAA(T,A,B) _(T,_cfPP) A[0][0][0][0][0][0] +#define PINT_cfAA(T,A,B) _(T,_cfAAP)(A,B) +#define PVOID_cfAA(T,A,B) (void *) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfAA(T,A,B) &B +#else +#define ROUTINE_cfAA(T,A,B) (cfCAST_FUNCTION)A +#endif +#define STRING_cfAA(T,A,B) STRING_cfCC(T,A,B) +#define PSTRING_cfAA(T,A,B) PSTRING_cfCC(T,A,B) +#ifdef vmsFortran +#define STRINGV_cfAA(T,A,B) &B +#else +#ifdef CRAYFortran +#define STRINGV_cfAA(T,A,B) _cptofcd(B.fs,B.flen) +#else +#define STRINGV_cfAA(T,A,B) B.fs +#endif +#endif +#define PSTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B) +#define ZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B) +#define PZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B) + +#if defined(vmsFortran) || defined(CRAYFortran) +#define JCF(TN,I) +#define KCF(TN,I) +#else +#define JCF(TN,I) _(TN,_cfSTR)(1,J,_(B,I), 0,0,0,0) +#if defined(AbsoftUNIXFortran) +#define DEFAULT_cfJ(B) ,0 +#else +#define DEFAULT_cfJ(B) +#endif +#define LOGICAL_cfJ(B) DEFAULT_cfJ(B) +#define PLOGICAL_cfJ(B) DEFAULT_cfJ(B) +#define STRING_cfJ(B) ,B.flen +#define PSTRING_cfJ(B) ,B +#define STRINGV_cfJ(B) STRING_cfJ(B) +#define PSTRINGV_cfJ(B) STRING_cfJ(B) +#define ZTRINGV_cfJ(B) STRING_cfJ(B) +#define PZTRINGV_cfJ(B) STRING_cfJ(B) + +/* KCF is identical to DCF, except that KCF ZTRING is not empty. */ +#define KCF(TN,I) _(TN,_cfSTR)(1,KK,_(B,I), 0,0,0,0) +#if defined(AbsoftUNIXFortran) +#define DEFAULT_cfKK(B) , unsigned B +#else +#define DEFAULT_cfKK(B) +#endif +#define LOGICAL_cfKK(B) DEFAULT_cfKK(B) +#define PLOGICAL_cfKK(B) DEFAULT_cfKK(B) +#define STRING_cfKK(B) , unsigned B +#define PSTRING_cfKK(B) STRING_cfKK(B) +#define STRINGV_cfKK(B) STRING_cfKK(B) +#define PSTRINGV_cfKK(B) STRING_cfKK(B) +#define ZTRINGV_cfKK(B) STRING_cfKK(B) +#define PZTRINGV_cfKK(B) STRING_cfKK(B) +#endif + +#define WCF(TN,AN,I) _(TN,_cfSTR)(2,W,AN,_(B,I), 0,0,0) +#define DEFAULT_cfW(A,B) +#define LOGICAL_cfW(A,B) +#define PLOGICAL_cfW(A,B) *B=F2CLOGICAL(*B); +#define STRING_cfW(A,B) (A[B.clen]!='\0'?A[B.clen]='\0':0); /* A?="constnt"*/ +#define PSTRING_cfW(A,B) kill_trailing(A,' '); +#ifdef vmsFortran +#define STRINGV_cfW(A,B) _cf_free(B.dsc$a_pointer); +#define PSTRINGV_cfW(A,B) \ + vkill_trailing(f2cstrv((char*)A, (char*)A, \ + B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]), \ + B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' '); +#else +#define STRINGV_cfW(A,B) _cf_free(B.s); +#define PSTRINGV_cfW(A,B) vkill_trailing( \ + f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' '); +#endif +#define ZTRINGV_cfW(A,B) STRINGV_cfW(A,B) +#define PZTRINGV_cfW(A,B) PSTRINGV_cfW(A,B) + +#define NCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,N,TN,_(A,I),0) +#define NNCF(TN,I,C) UUCF(TN,I,C) +#define NNNCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,N,TN,_(A,I),0) +#define INT_cfN(T,A) _(T,VVVVVVV_cfTYPE) * A +#define INTV_cfN(T,A) _(T,VVVVVV_cfTYPE) * A +#define INTVV_cfN(T,A) _(T,VVVVV_cfTYPE) * A +#define INTVVV_cfN(T,A) _(T,VVVV_cfTYPE) * A +#define INTVVVV_cfN(T,A) _(T,VVV_cfTYPE) * A +#define INTVVVVV_cfN(T,A) _(T,VV_cfTYPE) * A +#define INTVVVVVV_cfN(T,A) _(T,V_cfTYPE) * A +#define INTVVVVVVV_cfN(T,A) _(T,_cfTYPE) * A +#define PINT_cfN(T,A) _(T,_cfTYPE) * A +#define PVOID_cfN(T,A) void * A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfN(T,A) void (**A)(CF_NULL_PROTO) +#else +#define ROUTINE_cfN(T,A) void ( *A)(CF_NULL_PROTO) +#endif +#ifdef vmsFortran +#define STRING_cfN(T,A) fstring * A +#define STRINGV_cfN(T,A) fstringvector * A +#else +#ifdef CRAYFortran +#define STRING_cfN(T,A) _fcd A +#define STRINGV_cfN(T,A) _fcd A +#else +#define STRING_cfN(T,A) char * A +#define STRINGV_cfN(T,A) char * A +#endif +#endif +#define PSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */ +#define PNSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */ +#define PPSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */ +#define PSTRINGV_cfN(T,A) STRINGV_cfN(T,A) +#define ZTRINGV_cfN(T,A) STRINGV_cfN(T,A) +#define PZTRINGV_cfN(T,A) PSTRINGV_cfN(T,A) + + +/* Apollo 6.7, CRAY, old Sun, VAX/Ultrix vcc/cc and new ultrix + can't hack more than 31 arg's. + e.g. ultrix >= 4.3 gives message: + zow35> cc -c -DDECFortran cfortest.c + cfe: Fatal: Out of memory: cfortest.c + zow35> + Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine + if using -Aa, otherwise we have a problem. + */ +#ifndef MAX_PREPRO_ARGS +#if !defined(__GNUC__) && (defined(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR))) +#define MAX_PREPRO_ARGS 31 +#else +#define MAX_PREPRO_ARGS 99 +#endif +#endif + +#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) +/* In addition to explicit Absoft stuff, only Absoft requires: + - DEFAULT coming from _cfSTR. + DEFAULT could have been called e.g. INT, but keep it for clarity. + - M term in CFARGT14 and CFARGT14FS. + */ +#define ABSOFT_cf1(T0) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0) +#define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0) +#define ABSOFT_cf3(T0) _(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0) +#define DEFAULT_cfABSOFT1 +#define LOGICAL_cfABSOFT1 +#define STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING +#define DEFAULT_cfABSOFT2 +#define LOGICAL_cfABSOFT2 +#define STRING_cfABSOFT2 ,unsigned D0 +#define DEFAULT_cfABSOFT3 +#define LOGICAL_cfABSOFT3 +#define STRING_cfABSOFT3 ,D0 +#else +#define ABSOFT_cf1(T0) +#define ABSOFT_cf2(T0) +#define ABSOFT_cf3(T0) +#endif + +/* _Z introduced to cicumvent IBM and HP silly preprocessor warning. + e.g. "Macro CFARGT14 invoked with a null argument." + */ +#define _Z + +#define CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) +#define CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \ + S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \ + S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27) + +#define CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CFARGT27FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1) \ + F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \ + M CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) + +#if !(defined(PowerStationFortran)||defined(hpuxFortran800)) +/* Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields: + SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c + "c.c", line 406: warning: argument mismatch + Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok. + Behavior is most clearly seen in example: + #define A 1 , 2 + #define C(X,Y,Z) x=X. y=Y. z=Z. + #define D(X,Y,Z) C(X,Y,Z) + D(x,A,z) + Output from preprocessor is: x = x . y = 1 . z = 2 . + #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +*/ +#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1) \ + F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \ + M CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) + +#define CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \ + F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \ + S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) +#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \ + F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \ + F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \ + F(TD,AD,13,1) F(TE,AE,14,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \ + S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \ + S(TB,11) S(TC,12) S(TD,13) S(TE,14) +#if MAX_PREPRO_ARGS>31 +#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ + F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \ + F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \ + F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \ + F(TJ,AJ,19,1) F(TK,AK,20,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \ + S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \ + S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) S(TG,16) \ + S(TH,17) S(TI,18) S(TJ,19) S(TK,20) +#define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \ + F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \ + F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \ + F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \ + F(TJ,AJ,19,1) F(TK,AK,20,1) F(TL,AL,21,1) F(TM,AM,22,1) F(TN,AN,23,1) F(TO,AO,24,1) \ + F(TP,AP,25,1) F(TQ,AQ,26,1) F(TR,AR,27,1) S(T1,1) S(T2,2) S(T3,3) \ + S(T4,4) S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) \ + S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) \ + S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \ + S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27) +#endif +#else +#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \ + F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \ + F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \ + F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) +#define CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \ + F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \ + F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \ + F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \ + F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20) \ + F(TL,21,1) S(TL,21) F(TM,22,1) S(TM,22) F(TN,23,1) S(TN,23) F(TO,24,1) S(TO,24) \ + F(TP,25,1) S(TP,25) F(TQ,26,1) S(TQ,26) F(TR,27,1) S(TR,27) + +#define CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \ + F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \ + F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \ + F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \ + F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20) +#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \ + F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \ + F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \ + F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \ + F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \ + F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) +#if MAX_PREPRO_ARGS>31 +#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ + F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \ + F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \ + F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \ + F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \ + F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \ + F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \ + F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20) +#define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \ + F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \ + F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \ + F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \ + F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \ + F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \ + F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \ + F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20) F(TL,AL,21,1) S(TL,21) \ + F(TM,AM,22,1) S(TM,22) F(TN,AN,23,1) S(TN,23) F(TO,AO,24,1) S(TO,24) \ + F(TP,AP,25,1) S(TP,25) F(TQ,AQ,26,1) S(TQ,26) F(TR,AR,27,1) S(TR,27) +#endif +#endif + + +#define PROTOCCALLSFSUB1( UN,LN,T1) \ + PROTOCCALLSFSUB14(UN,LN,T1,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB2( UN,LN,T1,T2) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB3( UN,LN,T1,T2,T3) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB4( UN,LN,T1,T2,T3,T4) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define PROTOCCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + + +#define PROTOCCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0) +#define PROTOCCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0) + +#define PROTOCCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0) +#define PROTOCCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0) + + +#ifndef FCALLSC_QUALIFIER +#ifdef VISUAL_CPLUSPLUS +#define FCALLSC_QUALIFIER __stdcall +#else +#define FCALLSC_QUALIFIER +#endif +#endif + +#ifdef __cplusplus +#define CFextern extern "C" +#else +#define CFextern extern +#endif + + +#ifdef CFSUBASFUN +#define PROTOCCALLSFSUB0(UN,LN) \ + PROTOCCALLSFFUN0( VOID,UN,LN) +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFFUN14(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\ + PROTOCCALLSFFUN20(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\ + PROTOCCALLSFFUN27(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) +#else +/* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after + #include-ing cfortran.h if calling the FORTRAN wrapper within the same + source code where the wrapper is created. */ +#define PROTOCCALLSFSUB0(UN,LN) _(VOID,_cfPU)(CFC_(UN,LN))(); +#ifndef __CF__KnR +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT14(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ); +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\ + _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT20(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) ); +#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\ + _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT27(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) ); +#else +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFSUB0(UN,LN) +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + PROTOCCALLSFSUB0(UN,LN) +#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + PROTOCCALLSFSUB0(UN,LN) +#endif +#endif + + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + + +#define CCALLSFSUB1( UN,LN,T1, A1) \ + CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0) +#define CCALLSFSUB2( UN,LN,T1,T2, A1,A2) \ + CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0) +#define CCALLSFSUB3( UN,LN,T1,T2,T3, A1,A2,A3) \ + CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0) +#define CCALLSFSUB4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\ + CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0) +#define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0) +#define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0) +#define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0) +#define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0) +#define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0) +#define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0) +#define CCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0) +#define CCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0) +#define CCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0) + +#ifdef __cplusplus +#define CPPPROTOCLSFSUB0( UN,LN) +#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) +#else +#define CPPPROTOCLSFSUB0(UN,LN) \ + PROTOCCALLSFSUB0(UN,LN) +#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) +#endif + +#ifdef CFSUBASFUN +#define CCALLSFSUB0(UN,LN) CCALLSFFUN0(UN,LN) +#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) +#else +/* do{...}while(0) allows if(a==b) FORT(); else BORT(); */ +#define CCALLSFSUB0( UN,LN) do{CPPPROTOCLSFSUB0(UN,LN) CFC_(UN,LN)();}while(0) +#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \ + VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) \ + CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) \ + ACF(LN,T4,A4,4) ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) \ + ACF(LN,T8,A8,8) ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) \ + ACF(LN,TC,AC,12) ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) \ + CFC_(UN,LN)( CFARGTA14(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) );\ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) \ + WCF(TB,AB,11) WCF(TC,AC,12) WCF(TD,AD,13) WCF(TE,AE,14) }while(0) +#endif + + +#if MAX_PREPRO_ARGS>31 +#define CCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,0,0,0,0,0) +#define CCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,0,0,0,0) +#define CCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,0,0,0) +#define CCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,0,0) +#define CCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,0) + +#ifdef CFSUBASFUN +#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \ + TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ + CCALLSFFUN20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \ + TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) +#else +#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \ + TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \ + VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \ + VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \ + CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \ + ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \ + ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \ + ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \ + ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \ + CFC_(UN,LN)( CFARGTA20(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) ); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \ + WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \ + WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \ + WCF(TJ,AJ,19) WCF(TK,AK,20) }while(0) +#endif +#endif /* MAX_PREPRO_ARGS */ + +#if MAX_PREPRO_ARGS>31 +#define CCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,0,0,0,0,0,0) +#define CCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,0,0,0,0,0) +#define CCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,0,0,0,0) +#define CCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,0,0,0) +#define CCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,0,0) +#define CCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ)\ + CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,0) + +#ifdef CFSUBASFUN +#define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \ + A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \ + CCALLSFFUN27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \ + A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) +#else +#define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \ + A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \ + VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \ + VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \ + VVCF(TL,AL,B21) VVCF(TM,AM,B22) VVCF(TN,AN,B23) VVCF(TO,AO,B24) VVCF(TP,AP,B25) \ + VVCF(TQ,AQ,B26) VVCF(TR,AR,B27) \ + CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \ + ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \ + ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \ + ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \ + ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \ + ACF(LN,TL,AL,21) ACF(LN,TM,AM,22) ACF(LN,TN,AN,23) ACF(LN,TO,AO,24) \ + ACF(LN,TP,AP,25) ACF(LN,TQ,AQ,26) ACF(LN,TR,AR,27) \ + CFC_(UN,LN)( CFARGTA27(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,\ + A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) ); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \ + WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \ + WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \ + WCF(TJ,AJ,19) WCF(TK,AK,20) WCF(TL,AL,21) WCF(TM,AM,22) WCF(TN,AN,23) WCF(TO,AO,24) \ + WCF(TP,AP,25) WCF(TQ,AQ,26) WCF(TR,AR,27) }while(0) +#endif +#endif /* MAX_PREPRO_ARGS */ + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR C TO CALL FORTRAN FUNCTIONS */ + +/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN + function is called. Therefore, especially for creator's of C header files + for large FORTRAN libraries which include many functions, to reduce + compile time and object code size, it may be desirable to create + preprocessor directives to allow users to create code for only those + functions which they use. */ + +/* The following defines the maximum length string that a function can return. + Of course it may be undefine-d and re-define-d before individual + PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived + from the individual machines' limits. */ +#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE + +/* The following defines a character used by CFORTRAN.H to flag the end of a + string coming out of a FORTRAN routine. */ +#define CFORTRAN_NON_CHAR 0x7F + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#define _SEP_(TN,C,cfCOMMA) _(__SEP_,C)(TN,cfCOMMA) +#define __SEP_0(TN,cfCOMMA) +#define __SEP_1(TN,cfCOMMA) _Icf(2,SEP,TN,cfCOMMA,0) +#define INT_cfSEP(T,B) _(A,B) +#define INTV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define PINT_cfSEP(T,B) INT_cfSEP(T,B) +#define PVOID_cfSEP(T,B) INT_cfSEP(T,B) +#define ROUTINE_cfSEP(T,B) INT_cfSEP(T,B) +#define SIMPLE_cfSEP(T,B) INT_cfSEP(T,B) +#define VOID_cfSEP(T,B) INT_cfSEP(T,B) /* For FORTRAN calls C subr.s.*/ +#define STRING_cfSEP(T,B) INT_cfSEP(T,B) +#define STRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define PSTRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PNSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define PPSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define ZTRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PZTRINGV_cfSEP(T,B) INT_cfSEP(T,B) + +#if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE) +#ifdef OLD_VAXC +#define INTEGER_BYTE char /* Old VAXC barfs on 'signed char' */ +#else +#define INTEGER_BYTE signed char /* default */ +#endif +#else +#define INTEGER_BYTE unsigned char +#endif +#define BYTEVVVVVVV_cfTYPE INTEGER_BYTE +#define DOUBLEVVVVVVV_cfTYPE DOUBLE_PRECISION +#define FLOATVVVVVVV_cfTYPE FORTRAN_REAL +#define INTVVVVVVV_cfTYPE int +#define LOGICALVVVVVVV_cfTYPE int +#define LONGVVVVVVV_cfTYPE long +#define SHORTVVVVVVV_cfTYPE short +#define PBYTE_cfTYPE INTEGER_BYTE +#define PDOUBLE_cfTYPE DOUBLE_PRECISION +#define PFLOAT_cfTYPE FORTRAN_REAL +#define PINT_cfTYPE int +#define PLOGICAL_cfTYPE int +#define PLONG_cfTYPE long +#define PSHORT_cfTYPE short + +#define CFARGS0(A,T,V,W,X,Y,Z) _3(T,_cf,A) +#define CFARGS1(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V) +#define CFARGS2(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W) +#define CFARGS3(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X) +#define CFARGS4(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y) +#define CFARGS5(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y,Z) + +#define _Icf(N,T,I,X,Y) _(I,_cfINT)(N,T,I,X,Y,0) +#define _Icf4(N,T,I,X,Y,Z) _(I,_cfINT)(N,T,I,X,Y,Z) +#define BYTE_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define DOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INT,B,X,Y,Z,0) +#define FLOAT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define INT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define LOGICAL_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define LONG_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define SHORT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define PBYTE_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PINT,B,X,Y,Z,0) +#define PFLOAT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PINT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PLOGICAL_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PLONG_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PSHORT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define BYTEV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define BYTEVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define DOUBLEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTV,B,X,Y,Z,0) +#define DOUBLEVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVV,B,X,Y,Z,0) +#define DOUBLEVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVV,B,X,Y,Z,0) +#define DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVVV,B,X,Y,Z,0) +#define FLOATV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define FLOATVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define INTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define INTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define LONGVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define SHORTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define PVOID_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,B,B,X,Y,Z,0) +#define ROUTINE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +/*CRAY coughs on the first, + i.e. the usual trouble of not being able to + define macros to macros with arguments. + New ultrix is worse, it coughs on all such uses. + */ +/*#define SIMPLE_cfINT PVOID_cfINT*/ +#define SIMPLE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define VOID_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define STRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define STRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PSTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PNSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PPSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define ZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define CF_0_cfINT(N,A,B,X,Y,Z) + + +#define UCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,U,TN,_(A,I),0) +#define UUCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _SEP_(TN,1,I) +#define UUUCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,U,TN,_(A,I),0) +#define INT_cfU(T,A) _(T,VVVVVVV_cfTYPE) A +#define INTV_cfU(T,A) _(T,VVVVVV_cfTYPE) * A +#define INTVV_cfU(T,A) _(T,VVVVV_cfTYPE) * A +#define INTVVV_cfU(T,A) _(T,VVVV_cfTYPE) * A +#define INTVVVV_cfU(T,A) _(T,VVV_cfTYPE) * A +#define INTVVVVV_cfU(T,A) _(T,VV_cfTYPE) * A +#define INTVVVVVV_cfU(T,A) _(T,V_cfTYPE) * A +#define INTVVVVVVV_cfU(T,A) _(T,_cfTYPE) * A +#define PINT_cfU(T,A) _(T,_cfTYPE) * A +#define PVOID_cfU(T,A) void *A +#define ROUTINE_cfU(T,A) void (*A)(CF_NULL_PROTO) +#define VOID_cfU(T,A) void A /* Needed for C calls FORTRAN sub.s. */ +#define STRING_cfU(T,A) char *A /* via VOID and wrapper. */ +#define STRINGV_cfU(T,A) char *A +#define PSTRING_cfU(T,A) char *A +#define PSTRINGV_cfU(T,A) char *A +#define ZTRINGV_cfU(T,A) char *A +#define PZTRINGV_cfU(T,A) char *A + +/* VOID breaks U into U and UU. */ +#define INT_cfUU(T,A) _(T,VVVVVVV_cfTYPE) A +#define VOID_cfUU(T,A) /* Needed for FORTRAN calls C sub.s. */ +#define STRING_cfUU(T,A) char *A + + +#define BYTE_cfPU(A) CFextern INTEGER_BYTE FCALLSC_QUALIFIER A +#define DOUBLE_cfPU(A) CFextern DOUBLE_PRECISION FCALLSC_QUALIFIER A +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfPU(A) CFextern FORTRAN_REAL FCALLSC_QUALIFIER A +#else +#define FLOAT_cfPU(A) CFextern FLOATFUNCTIONTYPE FCALLSC_QUALIFIER A +#endif +#define INT_cfPU(A) CFextern int FCALLSC_QUALIFIER A +#define LOGICAL_cfPU(A) CFextern int FCALLSC_QUALIFIER A +#define LONG_cfPU(A) CFextern long FCALLSC_QUALIFIER A +#define SHORT_cfPU(A) CFextern short FCALLSC_QUALIFIER A +#define STRING_cfPU(A) CFextern void FCALLSC_QUALIFIER A +#define VOID_cfPU(A) CFextern void FCALLSC_QUALIFIER A + +#define BYTE_cfE INTEGER_BYTE A0; +#define DOUBLE_cfE DOUBLE_PRECISION A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfE FORTRAN_REAL A0; +#else +#define FLOAT_cfE FORTRAN_REAL AA0; FLOATFUNCTIONTYPE A0; +#endif +#define INT_cfE int A0; +#define LOGICAL_cfE int A0; +#define LONG_cfE long A0; +#define SHORT_cfE short A0; +#define VOID_cfE +#ifdef vmsFortran +#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + static fstring A0 = \ + {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\ + memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\ + *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0'; +#else +#ifdef CRAYFortran +#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\ + memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\ + A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING); +#else +/* 'cc: SC3.0.1 13 Jul 1994' barfs on char A0[0x4FE+1]; + * char A0[0x4FE +1]; char A0[1+0x4FE]; are both OK. */ +#define STRING_cfE static char A0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + memset(A0, CFORTRAN_NON_CHAR, \ + MAX_LEN_FORTRAN_FUNCTION_STRING); \ + *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0'; +#endif +#endif +/* ESTRING must use static char. array which is guaranteed to exist after + function returns. */ + +/* N.B.i) The diff. for 0 (Zero) and >=1 arguments. + ii)That the following create an unmatched bracket, i.e. '(', which + must of course be matched in the call. + iii)Commas must be handled very carefully */ +#define INT_cfGZ(T,UN,LN) A0=CFC_(UN,LN)( +#define VOID_cfGZ(T,UN,LN) CFC_(UN,LN)( +#ifdef vmsFortran +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)(&A0 +#else +#if defined(CRAYFortran) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0 +#else +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING +#endif +#endif + +#define INT_cfG(T,UN,LN) INT_cfGZ(T,UN,LN) +#define VOID_cfG(T,UN,LN) VOID_cfGZ(T,UN,LN) +#define STRING_cfG(T,UN,LN) STRING_cfGZ(T,UN,LN), /*, is only diff. from _cfG*/ + +#define BYTEVVVVVVV_cfPP +#define INTVVVVVVV_cfPP /* These complement FLOATVVVVVVV_cfPP. */ +#define DOUBLEVVVVVVV_cfPP +#define LOGICALVVVVVVV_cfPP +#define LONGVVVVVVV_cfPP +#define SHORTVVVVVVV_cfPP +#define PBYTE_cfPP +#define PINT_cfPP +#define PDOUBLE_cfPP +#define PLOGICAL_cfPP +#define PLONG_cfPP +#define PSHORT_cfPP +#define PFLOAT_cfPP FLOATVVVVVVV_cfPP + +#define BCF(TN,AN,C) _SEP_(TN,C,cfCOMMA) _Icf(2,B,TN,AN,0) +#define INT_cfB(T,A) (_(T,VVVVVVV_cfTYPE)) A +#define INTV_cfB(T,A) A +#define INTVV_cfB(T,A) (A)[0] +#define INTVVV_cfB(T,A) (A)[0][0] +#define INTVVVV_cfB(T,A) (A)[0][0][0] +#define INTVVVVV_cfB(T,A) (A)[0][0][0][0] +#define INTVVVVVV_cfB(T,A) (A)[0][0][0][0][0] +#define INTVVVVVVV_cfB(T,A) (A)[0][0][0][0][0][0] +#define PINT_cfB(T,A) _(T,_cfPP)&A +#define STRING_cfB(T,A) (char *) A +#define STRINGV_cfB(T,A) (char *) A +#define PSTRING_cfB(T,A) (char *) A +#define PSTRINGV_cfB(T,A) (char *) A +#define PVOID_cfB(T,A) (void *) A +#define ROUTINE_cfB(T,A) (cfCAST_FUNCTION)A +#define ZTRINGV_cfB(T,A) (char *) A +#define PZTRINGV_cfB(T,A) (char *) A + +#define SCF(TN,NAME,I,A) _(TN,_cfSTR)(3,S,NAME,I,A,0,0) +#define DEFAULT_cfS(M,I,A) +#define LOGICAL_cfS(M,I,A) +#define PLOGICAL_cfS(M,I,A) +#define STRING_cfS(M,I,A) ,sizeof(A) +#define STRINGV_cfS(M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \ + +secondindexlength(A)) +#define PSTRING_cfS(M,I,A) ,sizeof(A) +#define PSTRINGV_cfS(M,I,A) STRINGV_cfS(M,I,A) +#define ZTRINGV_cfS(M,I,A) +#define PZTRINGV_cfS(M,I,A) + +#define HCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA, H,_(C,I),0,0) +#define HHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA,HH,_(C,I),0,0) +#define HHHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOLON, H,_(C,I),0,0) +#define H_CF_SPECIAL unsigned +#define HH_CF_SPECIAL +#define DEFAULT_cfH(M,I,A) +#define LOGICAL_cfH(S,U,B) +#define PLOGICAL_cfH(S,U,B) +#define STRING_cfH(S,U,B) _(A,S) _(U,_CF_SPECIAL) B +#define STRINGV_cfH(S,U,B) STRING_cfH(S,U,B) +#define PSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define PSTRINGV_cfH(S,U,B) STRING_cfH(S,U,B) +#define PNSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define PPSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define ZTRINGV_cfH(S,U,B) +#define PZTRINGV_cfH(S,U,B) + +/* Need VOID_cfSTR because Absoft forced function types go through _cfSTR. */ +/* No spaces inside expansion. They screws up macro catenation kludge. */ +#define VOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICAL,A,B,C,D,E) +#define LONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PBYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLOGICAL,A,B,C,D,E) +#define PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PSHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define STRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRING,A,B,C,D,E) +#define PSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRING,A,B,C,D,E) +#define STRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRINGV,A,B,C,D,E) +#define PSTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRINGV,A,B,C,D,E) +#define PNSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PNSTRING,A,B,C,D,E) +#define PPSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PPSTRING,A,B,C,D,E) +#define PVOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define ROUTINE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SIMPLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define ZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,ZTRINGV,A,B,C,D,E) +#define PZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRINGV,A,B,C,D,E) +#define CF_0_cfSTR(N,T,A,B,C,D,E) + +/* See ACF table comments, which explain why CCF was split into two. */ +#define CCF(NAME,TN,I) _(TN,_cfSTR)(5,C,NAME,I,_(A,I),_(B,I),_(C,I)) +#define DEFAULT_cfC(M,I,A,B,C) +#define LOGICAL_cfC(M,I,A,B,C) A=C2FLOGICAL( A); +#define PLOGICAL_cfC(M,I,A,B,C) *A=C2FLOGICAL(*A); +#ifdef vmsFortran +#define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A, \ + C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.f.dsc$w_length=B.clen: \ + (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0')); + /* PSTRING_cfC to beware of array A which does not contain any \0. */ +#define PSTRING_cfC(M,I,A,B,C) (B.dsc$a_pointer=A, C==sizeof(char*) ? \ + B.dsc$w_length=strlen(A): (A[C-1]='\0',B.dsc$w_length=strlen(A), \ + memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), B.dsc$w_length=C-1)); +#else +#define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A), \ + C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.flen=B.clen: \ + (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0')); +#define PSTRING_cfC(M,I,A,B,C) (C==sizeof(char*)? B=strlen(A): \ + (A[C-1]='\0',B=strlen(A),memset((A)+B,' ',C-B-1),B=C-1)); +#endif + /* For CRAYFortran for (P)STRINGV_cfC, B.fs is set, but irrelevant. */ +#define STRINGV_cfC(M,I,A,B,C) \ + AATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF) +#define PSTRINGV_cfC(M,I,A,B,C) \ + APATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF) +#define ZTRINGV_cfC(M,I,A,B,C) \ + AATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 ) +#define PZTRINGV_cfC(M,I,A,B,C) \ + APATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 ) + +#define BYTE_cfCCC(A,B) &A +#define DOUBLE_cfCCC(A,B) &A +#if !defined(__CF__KnR) +#define FLOAT_cfCCC(A,B) &A + /* Although the VAX doesn't, at least the */ +#else /* HP and K&R mips promote float arg.'s of */ +#define FLOAT_cfCCC(A,B) &B /* unprototyped functions to double. Cannot */ +#endif /* use A here to pass the argument to FORTRAN. */ +#define INT_cfCCC(A,B) &A +#define LOGICAL_cfCCC(A,B) &A +#define LONG_cfCCC(A,B) &A +#define SHORT_cfCCC(A,B) &A +#define PBYTE_cfCCC(A,B) A +#define PDOUBLE_cfCCC(A,B) A +#define PFLOAT_cfCCC(A,B) A +#define PINT_cfCCC(A,B) A +#define PLOGICAL_cfCCC(A,B) B=A /* B used to keep a common W table. */ +#define PLONG_cfCCC(A,B) A +#define PSHORT_cfCCC(A,B) A + +#define CCCF(TN,I,M) _SEP_(TN,M,cfCOMMA) _Icf(3,CC,TN,_(A,I),_(B,I)) +#define INT_cfCC(T,A,B) _(T,_cfCCC)(A,B) +#define INTV_cfCC(T,A,B) A +#define INTVV_cfCC(T,A,B) A +#define INTVVV_cfCC(T,A,B) A +#define INTVVVV_cfCC(T,A,B) A +#define INTVVVVV_cfCC(T,A,B) A +#define INTVVVVVV_cfCC(T,A,B) A +#define INTVVVVVVV_cfCC(T,A,B) A +#define PINT_cfCC(T,A,B) _(T,_cfCCC)(A,B) +#define PVOID_cfCC(T,A,B) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfCC(T,A,B) &A +#else +#define ROUTINE_cfCC(T,A,B) A +#endif +#define SIMPLE_cfCC(T,A,B) A +#ifdef vmsFortran +#define STRING_cfCC(T,A,B) &B.f +#define STRINGV_cfCC(T,A,B) &B +#define PSTRING_cfCC(T,A,B) &B +#define PSTRINGV_cfCC(T,A,B) &B +#else +#ifdef CRAYFortran +#define STRING_cfCC(T,A,B) _cptofcd(A,B.flen) +#define STRINGV_cfCC(T,A,B) _cptofcd(B.s,B.flen) +#define PSTRING_cfCC(T,A,B) _cptofcd(A,B) +#define PSTRINGV_cfCC(T,A,B) _cptofcd(A,B.flen) +#else +#define STRING_cfCC(T,A,B) A +#define STRINGV_cfCC(T,A,B) B.fs +#define PSTRING_cfCC(T,A,B) A +#define PSTRINGV_cfCC(T,A,B) B.fs +#endif +#endif +#define ZTRINGV_cfCC(T,A,B) STRINGV_cfCC(T,A,B) +#define PZTRINGV_cfCC(T,A,B) PSTRINGV_cfCC(T,A,B) + +#define BYTE_cfX return A0; +#define DOUBLE_cfX return A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfX return A0; +#else +#define FLOAT_cfX ASSIGNFLOAT(AA0,A0); return AA0; +#endif +#define INT_cfX return A0; +#define LOGICAL_cfX return F2CLOGICAL(A0); +#define LONG_cfX return A0; +#define SHORT_cfX return A0; +#define VOID_cfX return ; +#if defined(vmsFortran) || defined(CRAYFortran) +#define STRING_cfX return kill_trailing( \ + kill_trailing(AA0,CFORTRAN_NON_CHAR),' '); +#else +#define STRING_cfX return kill_trailing( \ + kill_trailing( A0,CFORTRAN_NON_CHAR),' '); +#endif + +#define CFFUN(NAME) _(__cf__,NAME) + +/* Note that we don't use LN here, but we keep it for consistency. */ +#define CCALLSFFUN0(UN,LN) CFFUN(UN)() + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define CCALLSFFUN1( UN,LN,T1, A1) \ + CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0) +#define CCALLSFFUN2( UN,LN,T1,T2, A1,A2) \ + CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0) +#define CCALLSFFUN3( UN,LN,T1,T2,T3, A1,A2,A3) \ + CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0) +#define CCALLSFFUN4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\ + CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0) +#define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0) +#define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0) +#define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0) +#define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0) +#define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0) +#define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0) +#define CCALLSFFUN11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0) +#define CCALLSFFUN12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0) +#define CCALLSFFUN13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0) + +#define CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\ +((CFFUN(UN)( BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \ + BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \ + BCF(TB,AB,1) BCF(TC,AC,1) BCF(TD,AD,1) BCF(TE,AE,1) \ + SCF(T1,LN,1,A1) SCF(T2,LN,2,A2) SCF(T3,LN,3,A3) SCF(T4,LN,4,A4) \ + SCF(T5,LN,5,A5) SCF(T6,LN,6,A6) SCF(T7,LN,7,A7) SCF(T8,LN,8,A8) \ + SCF(T9,LN,9,A9) SCF(TA,LN,10,AA) SCF(TB,LN,11,AB) SCF(TC,LN,12,AC) \ + SCF(TD,LN,13,AD) SCF(TE,LN,14,AE)))) + +/* N.B. Create a separate function instead of using (call function, function +value here) because in order to create the variables needed for the input +arg.'s which may be const.'s one has to do the creation within {}, but these +can never be placed within ()'s. Therefore one must create wrapper functions. +gcc, on the other hand may be able to avoid the wrapper functions. */ + +/* Prototypes are needed to correctly handle the value returned correctly. N.B. +Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN +functions returning strings have extra arg.'s. Don't bother, since this only +causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn +for the same function in the same source code. Something done by the experts in +debugging only.*/ + +#define PROTOCCALLSFFUN0(F,UN,LN) \ +_(F,_cfPU)( CFC_(UN,LN))(CF_NULL_PROTO); \ +static _Icf(2,U,F,CFFUN(UN),0)() {_(F,_cfE) _Icf(3,GZ,F,UN,LN) ABSOFT_cf1(F));_(F,_cfX)} + +#define PROTOCCALLSFFUN1( T0,UN,LN,T1) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0) +#define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0) +#define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0) +#define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0) +#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN11(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN12(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define PROTOCCALLSFFUN13(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + +/* HP/UX 9.01 cc requires the blank between '_Icf(3,G,T0,UN,LN) CCCF(T1,1,0)' */ + +#ifndef __CF__KnR +#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \ + CFARGT14FS(UCF,HCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ +{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \ + CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \ + CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \ + CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \ + CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \ + WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)} +#else +#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \ + CFARGT14FS(UUCF,HHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ + CFARGT14FS(UUUCF,HHHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ; \ +{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \ + CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \ + CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \ + CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \ + CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \ + WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)} +#endif + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR FORTRAN TO CALL C ROUTINES */ + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#if defined(vmsFortran) || defined(CRAYFortran) +#define DCF(TN,I) +#define DDCF(TN,I) +#define DDDCF(TN,I) +#else +#define DCF(TN,I) HCF(TN,I) +#define DDCF(TN,I) HHCF(TN,I) +#define DDDCF(TN,I) HHHCF(TN,I) +#endif + +#define QCF(TN,I) _(TN,_cfSTR)(1,Q,_(B,I), 0,0,0,0) +#define DEFAULT_cfQ(B) +#define LOGICAL_cfQ(B) +#define PLOGICAL_cfQ(B) +#define STRINGV_cfQ(B) char *B; unsigned int _(B,N); +#define STRING_cfQ(B) char *B=NULL; +#define PSTRING_cfQ(B) char *B=NULL; +#define PSTRINGV_cfQ(B) STRINGV_cfQ(B) +#define PNSTRING_cfQ(B) char *B=NULL; +#define PPSTRING_cfQ(B) + +#ifdef __sgi /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */ +#define ROUTINE_orig *(void**)& +#else +#define ROUTINE_orig (void *) +#endif + +#define ROUTINE_1 ROUTINE_orig +#define ROUTINE_2 ROUTINE_orig +#define ROUTINE_3 ROUTINE_orig +#define ROUTINE_4 ROUTINE_orig +#define ROUTINE_5 ROUTINE_orig +#define ROUTINE_6 ROUTINE_orig +#define ROUTINE_7 ROUTINE_orig +#define ROUTINE_8 ROUTINE_orig +#define ROUTINE_9 ROUTINE_orig +#define ROUTINE_10 ROUTINE_orig +#define ROUTINE_11 ROUTINE_orig +#define ROUTINE_12 ROUTINE_orig +#define ROUTINE_13 ROUTINE_orig +#define ROUTINE_14 ROUTINE_orig +#define ROUTINE_15 ROUTINE_orig +#define ROUTINE_16 ROUTINE_orig +#define ROUTINE_17 ROUTINE_orig +#define ROUTINE_18 ROUTINE_orig +#define ROUTINE_19 ROUTINE_orig +#define ROUTINE_20 ROUTINE_orig +#define ROUTINE_21 ROUTINE_orig +#define ROUTINE_22 ROUTINE_orig +#define ROUTINE_23 ROUTINE_orig +#define ROUTINE_24 ROUTINE_orig +#define ROUTINE_25 ROUTINE_orig +#define ROUTINE_26 ROUTINE_orig +#define ROUTINE_27 ROUTINE_orig + +#define TCF(NAME,TN,I,M) _SEP_(TN,M,cfCOMMA) _(TN,_cfT)(NAME,I,_(A,I),_(B,I),_(C,I)) +#define BYTE_cfT(M,I,A,B,D) *A +#define DOUBLE_cfT(M,I,A,B,D) *A +#define FLOAT_cfT(M,I,A,B,D) *A +#define INT_cfT(M,I,A,B,D) *A +#define LOGICAL_cfT(M,I,A,B,D) F2CLOGICAL(*A) +#define LONG_cfT(M,I,A,B,D) *A +#define SHORT_cfT(M,I,A,B,D) *A +#define BYTEV_cfT(M,I,A,B,D) A +#define DOUBLEV_cfT(M,I,A,B,D) A +#define FLOATV_cfT(M,I,A,B,D) VOIDP A +#define INTV_cfT(M,I,A,B,D) A +#define LOGICALV_cfT(M,I,A,B,D) A +#define LONGV_cfT(M,I,A,B,D) A +#define SHORTV_cfT(M,I,A,B,D) A +#define BYTEVV_cfT(M,I,A,B,D) (void *)A /* We have to cast to void *,*/ +#define BYTEVVV_cfT(M,I,A,B,D) (void *)A /* since we don't know the */ +#define BYTEVVVV_cfT(M,I,A,B,D) (void *)A /* dimensions of the array. */ +#define BYTEVVVVV_cfT(M,I,A,B,D) (void *)A /* i.e. Unfortunately, can't */ +#define BYTEVVVVVV_cfT(M,I,A,B,D) (void *)A /* check that the type */ +#define BYTEVVVVVVV_cfT(M,I,A,B,D) (void *)A /* matches the prototype. */ +#define DOUBLEVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVV_cfT(M,I,A,B,D) (void *)A +#define INTVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define PBYTE_cfT(M,I,A,B,D) A +#define PDOUBLE_cfT(M,I,A,B,D) A +#define PFLOAT_cfT(M,I,A,B,D) VOIDP A +#define PINT_cfT(M,I,A,B,D) A +#define PLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A) +#define PLONG_cfT(M,I,A,B,D) A +#define PSHORT_cfT(M,I,A,B,D) A +#define PVOID_cfT(M,I,A,B,D) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) (*A) +#else +#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) A +#endif +/* A == pointer to the characters + D == length of the string, or of an element in an array of strings + E == number of elements in an array of strings */ +#define TTSTR( A,B,D) \ + ((B=_cf_malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' ')) +#define TTTTSTR( A,B,D) (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL: \ + memchr(A,'\0',D) ?A : TTSTR(A,B,D) +#define TTTTSTRV( A,B,D,E) (_(B,N)=E,B=_cf_malloc(_(B,N)*(D+1)), (void *) \ + vkill_trailing(f2cstrv(A,B,D+1, _(B,N)*(D+1)), D+1,_(B,N)*(D+1),' ')) +#ifdef vmsFortran +#define STRING_cfT(M,I,A,B,D) TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \ + A->dsc$w_length , A->dsc$l_m[0]) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define PPSTRING_cfT(M,I,A,B,D) A->dsc$a_pointer +#else +#ifdef CRAYFortran +#define STRING_cfT(M,I,A,B,D) TTTTSTR( _fcdtocp(A),B,_fcdlen(A)) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(_fcdtocp(A),B,_fcdlen(A), \ + num_elem(_fcdtocp(A),_fcdlen(A),_3(M,_STRV_A,I))) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( _fcdtocp(A),B,_fcdlen(A)) +#define PPSTRING_cfT(M,I,A,B,D) _fcdtocp(A) +#else +#define STRING_cfT(M,I,A,B,D) TTTTSTR( A,B,D) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A,B,D, num_elem(A,D,_3(M,_STRV_A,I))) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( A,B,D) +#define PPSTRING_cfT(M,I,A,B,D) A +#endif +#endif +#define PNSTRING_cfT(M,I,A,B,D) STRING_cfT(M,I,A,B,D) +#define PSTRINGV_cfT(M,I,A,B,D) STRINGV_cfT(M,I,A,B,D) +#define CF_0_cfT(M,I,A,B,D) + +#define RCF(TN,I) _(TN,_cfSTR)(3,R,_(A,I),_(B,I),_(C,I),0,0) +#define DEFAULT_cfR(A,B,D) +#define LOGICAL_cfR(A,B,D) +#define PLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A); +#define STRING_cfR(A,B,D) if (B) _cf_free(B); +#define STRINGV_cfR(A,B,D) _cf_free(B); +/* A and D as defined above for TSTRING(V) */ +#define RRRRPSTR( A,B,D) if (B) memcpy(A,B, _cfMIN(strlen(B),D)), \ + (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), _cf_free(B); +#define RRRRPSTRV(A,B,D) c2fstrv(B,A,D+1,(D+1)*_(B,N)), _cf_free(B); +#ifdef vmsFortran +#define PSTRING_cfR(A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length) +#else +#ifdef CRAYFortran +#define PSTRING_cfR(A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A)) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A)) +#else +#define PSTRING_cfR(A,B,D) RRRRPSTR( A,B,D) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A,B,D) +#endif +#endif +#define PNSTRING_cfR(A,B,D) PSTRING_cfR(A,B,D) +#define PPSTRING_cfR(A,B,D) + +#define BYTE_cfFZ(UN,LN) INTEGER_BYTE FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define DOUBLE_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define INT_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define LOGICAL_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define LONG_cfFZ(UN,LN) long FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define SHORT_cfFZ(UN,LN) short FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define VOID_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)( +#ifndef __CF__KnR +/* The void is req'd by the Apollo, to make this an ANSI function declaration. + The Apollo promotes K&R float functions to double. */ +#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(void +#ifdef vmsFortran +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(fstring *AS +#else +#ifdef CRAYFortran +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(_fcd AS +#else +#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS +#else +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS, unsigned D0 +#endif +#endif +#endif +#else +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)( +#else +#define FLOAT_cfFZ(UN,LN) FLOATFUNCTIONTYPE FCALLSC_QUALIFIER fcallsc(UN,LN)( +#endif +#if defined(vmsFortran) || defined(CRAYFortran) || defined(AbsoftUNIXFortran) +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS +#else +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS, D0 +#endif +#endif + +#define BYTE_cfF(UN,LN) BYTE_cfFZ(UN,LN) +#define DOUBLE_cfF(UN,LN) DOUBLE_cfFZ(UN,LN) +#ifndef __CF_KnR +#define FLOAT_cfF(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)( +#else +#define FLOAT_cfF(UN,LN) FLOAT_cfFZ(UN,LN) +#endif +#define INT_cfF(UN,LN) INT_cfFZ(UN,LN) +#define LOGICAL_cfF(UN,LN) LOGICAL_cfFZ(UN,LN) +#define LONG_cfF(UN,LN) LONG_cfFZ(UN,LN) +#define SHORT_cfF(UN,LN) SHORT_cfFZ(UN,LN) +#define VOID_cfF(UN,LN) VOID_cfFZ(UN,LN) +#define STRING_cfF(UN,LN) STRING_cfFZ(UN,LN), + +#define INT_cfFF +#define VOID_cfFF +#ifdef vmsFortran +#define STRING_cfFF fstring *AS; +#else +#ifdef CRAYFortran +#define STRING_cfFF _fcd AS; +#else +#define STRING_cfFF char *AS; unsigned D0; +#endif +#endif + +#define INT_cfL A0= +#define STRING_cfL A0= +#define VOID_cfL + +#define INT_cfK +#define VOID_cfK +/* KSTRING copies the string into the position provided by the caller. */ +#ifdef vmsFortran +#define STRING_cfK \ + memcpy(AS->dsc$a_pointer,A0,_cfMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))));\ + AS->dsc$w_length>(A0==NULL?0:strlen(A0))? \ + memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ', \ + AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0; +#else +#ifdef CRAYFortran +#define STRING_cfK \ + memcpy(_fcdtocp(AS),A0, _cfMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) ); \ + _fcdlen(AS)>(A0==NULL?0:strlen(A0))? \ + memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ', \ + _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0; +#else +#define STRING_cfK memcpy(AS,A0, _cfMIN(D0,(A0==NULL?0:strlen(A0))) ); \ + D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \ + ' ', D0-(A0==NULL?0:strlen(A0))):0; +#endif +#endif + +/* Note that K.. and I.. can't be combined since K.. has to access data before +R.., in order for functions returning strings which are also passed in as +arguments to work correctly. Note that R.. frees and hence may corrupt the +string. */ +#define BYTE_cfI return A0; +#define DOUBLE_cfI return A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfI return A0; +#else +#define FLOAT_cfI RETURNFLOAT(A0); +#endif +#define INT_cfI return A0; +#ifdef hpuxFortran800 +/* Incredibly, functions must return true as 1, elsewhere .true.==0x01000000. */ +#define LOGICAL_cfI return ((A0)?1:0); +#else +#define LOGICAL_cfI return C2FLOGICAL(A0); +#endif +#define LONG_cfI return A0; +#define SHORT_cfI return A0; +#define STRING_cfI return ; +#define VOID_cfI return ; + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define FCALLSCSUB0( CN,UN,LN) FCALLSCFUN0(VOID,CN,UN,LN) +#define FCALLSCSUB1( CN,UN,LN,T1) FCALLSCFUN1(VOID,CN,UN,LN,T1) +#define FCALLSCSUB2( CN,UN,LN,T1,T2) FCALLSCFUN2(VOID,CN,UN,LN,T1,T2) +#define FCALLSCSUB3( CN,UN,LN,T1,T2,T3) FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3) +#define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) \ + FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4) +#define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \ + FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5) +#define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \ + FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6) +#define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) +#define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) +#define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) +#define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) +#define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) +#define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) +#define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) +#define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define FCALLSCSUB15(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \ + FCALLSCFUN15(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) +#define FCALLSCSUB16(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \ + FCALLSCFUN16(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) +#define FCALLSCSUB17(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \ + FCALLSCFUN17(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) +#define FCALLSCSUB18(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \ + FCALLSCFUN18(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) +#define FCALLSCSUB19(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \ + FCALLSCFUN19(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) +#define FCALLSCSUB20(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + FCALLSCFUN20(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#define FCALLSCSUB21(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \ + FCALLSCFUN21(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) +#define FCALLSCSUB22(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \ + FCALLSCFUN22(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) +#define FCALLSCSUB23(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \ + FCALLSCFUN23(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) +#define FCALLSCSUB24(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \ + FCALLSCFUN24(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) +#define FCALLSCSUB25(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \ + FCALLSCFUN25(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) +#define FCALLSCSUB26(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \ + FCALLSCFUN26(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) +#define FCALLSCSUB27(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + FCALLSCFUN27(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) + + +#define FCALLSCFUN1( T0,CN,UN,LN,T1) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0) +#define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0) +#define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0) +#define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0) +#define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0) +#define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0) +#define FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN11(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define FCALLSCFUN12(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define FCALLSCFUN13(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + + +#define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN16(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN17(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0) +#define FCALLSCFUN18(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0) +#define FCALLSCFUN19(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \ + FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0) +#define FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN21(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN22(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN23(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN24(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0) +#define FCALLSCFUN25(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0) +#define FCALLSCFUN26(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \ + FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0) + + +#ifndef __CF__KnR +#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf2(T0)) \ + {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)} + +#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ + { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \ + TCF(LN,TD,13,1) TCF(LN,TE,14,1) ); _Icf(0,K,T0,0,0) \ + CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI) } + +#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT27(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) ) \ + { CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \ + TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \ + TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \ + TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \ + CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) _(T0,_cfI) } + +#else +#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf3(T0)) _Icf(0,FF,T0,0,0)\ + {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)} + +#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) _Icf(0,FF,T0,0,0) \ + CFARGT14FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE); \ + { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \ + TCF(LN,TD,13,1) TCF(LN,TE,14,1) ); _Icf(0,K,T0,0,0) \ + CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI)} + +#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT27(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)) _Icf(0,FF,T0,0,0) \ + CFARGT27FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR); \ + { CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,10,1) TCF(LN,TB,11,1) TCF(LN,TC,12,1) \ + TCF(LN,TD,13,1) TCF(LN,TE,14,1) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \ + TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \ + TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \ + CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) _(T0,_cfI)} + +#endif + + +#endif /* __CFORTRAN_LOADED */ diff --git a/src/include/cfortran.h.3.9 b/src/include/cfortran.h.3.9 new file mode 100644 index 0000000..0688224 --- /dev/null +++ b/src/include/cfortran.h.3.9 @@ -0,0 +1,2149 @@ +/* cfortran.h 3.9 */ /* anonymous ftp@zebra.desy.de */ +/* Burkhard Burow burow@desy.de 1990 - 1997. */ + +#ifndef __CFORTRAN_LOADED +#define __CFORTRAN_LOADED + +/* + THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU + SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING, + MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE. +*/ + +/******* + Modifications: + Oct 1997: Changed symbol name extname to appendus (PDW/HSTX) + (Conflicted with a common variable name in FTOOLS) + Nov 1997: If g77Fortran defined, also define f2cFortran (PDW/HSTX) + Nov 1997: Define MIN(A,B) as _cfMIN(A,B) + Feb 1998: Let VMS see the NUM_ELEMS code. Lets programs treat + single strings as vectors with single elements + *******/ +#define MIN(A,B) _cfMIN(A,B) + +/* + Avoid symbols already used by compilers and system *.h: + __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c + + */ + + +/* First prepare for the C compiler. */ + +#ifndef ANSI_C_preprocessor /* i.e. user can override. */ +#ifdef __CF__KnR +#define ANSI_C_preprocessor 0 +#else +#ifdef __STDC__ +#define ANSI_C_preprocessor 1 +#else +#define _cfleft 1 +#define _cfright +#define _cfleft_cfright 0 +#define ANSI_C_preprocessor _cfleft/**/_cfright +#endif +#endif +#endif + +#if ANSI_C_preprocessor +#define _0(A,B) A##B +#define _(A,B) _0(A,B) /* see cat,xcat of K&R ANSI C p. 231 */ +#define _2(A,B) A##B /* K&R ANSI C p.230: .. identifier is not replaced */ +#define _3(A,B,C) _(A,_(B,C)) +#else /* if it turns up again during rescanning. */ +#define _(A,B) A/**/B +#define _2(A,B) A/**/B +#define _3(A,B,C) A/**/B/**/C +#endif + +#if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__)) +#define VAXUltrix +#endif + +#include <stdio.h> /* NULL [in all machines stdio.h] */ +#include <string.h> /* strlen, memset, memcpy, memchr. */ +#if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) ) +#include <stdlib.h> /* malloc,free */ +#else +#include <malloc.h> /* Had to be removed for DomainOS h105 10.4 sys5.3 425t*/ +#ifdef apollo +#define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */ +#endif +#endif + +#if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx)) +#define __CF__KnR /* Sun, LynxOS and VAX Ultrix cc only supports K&R. */ + /* Manually define __CF__KnR for HP if desired/required.*/ +#endif /* i.e. We will generate Kernighan and Ritchie C. */ +/* Note that you may define __CF__KnR before #include cfortran.h, in order to +generate K&R C instead of the default ANSI C. The differences are mainly in the +function prototypes and declarations. All machines, except the Apollo, work +with either style. The Apollo's argument promotion rules require ANSI or use of +the obsolete std_$call which we have not implemented here. Hence on the Apollo, +only C calling FORTRAN subroutines will work using K&R style.*/ + + +/* Remainder of cfortran.h depends on the Fortran compiler. */ + +#if defined(CLIPPERFortran) || defined(g77Fortran) /* 11/3/97 PDW */ +#define f2cFortran +#endif + +/* VAX/VMS does not let us \-split long #if lines. */ +/* Split #if into 2 because some HP-UX can't handle long #if */ +#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)) +#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(SXFortran)) +/* If no Fortran compiler is given, we choose one for the machines we know. */ +#if defined(lynx) || defined(VAXUltrix) +#define f2cFortran /* Lynx: Only support f2c at the moment. + VAXUltrix: f77 behaves like f2c. + Support f2c or f77 with gcc, vcc with f2c. + f77 with vcc works, missing link magic for f77 I/O.*/ +#endif +#if defined(WIN32) || defined(macintosh) +#define f2cFortran +#endif +#if defined(__hpux) /* 921107: Use __hpux instead of __hp9000s300 */ +#define hpuxFortran /* Should also allow hp9000s7/800 use.*/ +#endif +#if defined(apollo) +#define apolloFortran /* __CF__APOLLO67 also defines some behavior. */ +#endif +#if defined(sun) || defined(__sun) +#define sunFortran +#endif +#if defined(_IBMR2) +#define IBMR2Fortran +#endif +#if defined(_CRAY) +#define CRAYFortran /* _CRAYT3E also defines some behavior. */ +#endif +#if defined(_SX) +#define SXFortran +#endif +#if defined(mips) || defined(__mips) +#define mipsFortran +#endif +#if defined(vms) || defined(__vms) +#define vmsFortran +#endif +#if defined(__alpha) && defined(__unix__) +#define DECFortran +#endif +#if defined(__convex__) +#define CONVEXFortran +#endif +#if defined(VISUAL_CPLUSPLUS) +#define PowerStationFortran +#endif +#endif /* ...Fortran */ +#endif /* ...Fortran */ + +/* Split #if into 2 because some HP-UX can't handle long #if */ +#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran)) +#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(SXFortran)) +/* If your compiler barfs on ' #error', replace # with the trigraph for # */ + #error "cfortran.h: Can't find your environment among:\ + - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...) \ + - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000 \ + - VAX VMS CC 3.1 and FORTRAN 5.4. \ + - Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0. \ + - Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2 \ + - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7. \ + - CRAY \ + - NEC SX-4 SUPER-UX \ + - CONVEX \ + - Sun \ + - PowerStation Fortran with Visual C++ \ + - HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730 \ + - LynxOS: cc or gcc with f2c. \ + - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77. \ + - f77 with vcc works; but missing link magic for f77 I/O. \ + - NO fort. None of gcc, cc or vcc generate required names.\ + - f2c : Use #define f2cFortran, or cc -Df2cFortran \ + - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran \ + - g77 v0.5.18 for linux \ + - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran" +/* Compiler must throw us out at this point! */ +#endif +#endif + + +#if defined(VAXC) && !defined(__VAXC) +#define OLD_VAXC +#pragma nostandard /* Prevent %CC-I-PARAMNOTUSED. */ +#endif + +/* Throughout cfortran.h we use: UN = Uppercase Name. LN = Lowercase Name. */ + +#if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(appendus) /* 10/31/97 PDW */ +#define CFC_(UN,LN) _(LN,_) /* Lowercase FORTRAN symbols. */ +#define orig_fcallsc(UN,LN) CFC_(UN,LN) +#else +#if defined(CRAYFortran) || defined(PowerStationFortran) +#ifdef _CRAY /* (UN), not UN, circumvents CRAY preprocessor bug. */ +#define CFC_(UN,LN) (UN) /* Uppercase FORTRAN symbols. */ +#else /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */ +#define CFC_(UN,LN) UN /* Uppercase FORTRAN symbols. */ +#endif +#define orig_fcallsc(UN,LN) CFC_(UN,LN) /* CRAY insists on arg.'s here. */ +#else /* For following machines one may wish to change the fcallsc default. */ +#define CF_SAME_NAMESPACE +#ifdef vmsFortran +#define CFC_(UN,LN) LN /* Either case FORTRAN symbols. */ + /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/ + /* because VAX/VMS doesn't do recursive macros. */ +#define orig_fcallsc(UN,LN) UN +#else /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */ +#define CFC_(UN,LN) LN /* Lowercase FORTRAN symbols. */ +#define orig_fcallsc(UN,LN) CFC_(UN,LN) +#endif /* vmsFortran */ +#endif /* CRAYFortran PowerStationFortran */ +#endif /* ....Fortran */ + +#define fcallsc(UN,LN) orig_fcallsc(UN,LN) +#define preface_fcallsc(P,p,UN,LN) CFC_(_(P,UN),_(p,LN)) +#define append_fcallsc(P,p,UN,LN) CFC_(_(UN,P),_(LN,p)) + +#define C_FUNCTION(UN,LN) fcallsc(UN,LN) +#define FORTRAN_FUNCTION(UN,LN) CFC_(UN,LN) + +#ifndef COMMON_BLOCK +#ifndef CONVEXFortran +#ifndef CLIPPERFortran +#ifndef AbsoftUNIXFortran +#define COMMON_BLOCK(UN,LN) CFC_(UN,LN) +#else +#define COMMON_BLOCK(UN,LN) _(_C,LN) +#endif +#else +#define COMMON_BLOCK(UN,LN) _(LN,__) +#endif +#else +#define COMMON_BLOCK(UN,LN) _3(_,LN,_) +#endif +#endif + +#ifndef DOUBLE_PRECISION +#if defined(CRAYFortran) && !defined(_CRAYT3E) +#define DOUBLE_PRECISION long double +#else +#define DOUBLE_PRECISION double +#endif +#endif + +#ifndef FORTRAN_REAL +#if defined(CRAYFortran) && defined(_CRAYT3E) +#define FORTRAN_REAL double +#else +#define FORTRAN_REAL float +#endif +#endif + +#ifdef CRAYFortran +#ifdef _CRAY +#include <fortran.h> +#else +#include "fortran.h" /* i.e. if crosscompiling assume user has file. */ +#endif +#define FLOATVVVVVVV_cfPP (FORTRAN_REAL *) /* Used for C calls FORTRAN. */ +/* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/ +#define VOIDP (void *) /* When FORTRAN calls C, we don't know if C routine + arg.'s have been declared float *, or double *. */ +#else +#define FLOATVVVVVVV_cfPP +#define VOIDP +#endif + +#ifdef vmsFortran +#if defined(vms) || defined(__vms) +#include <descrip.h> +#else +#include "descrip.h" /* i.e. if crosscompiling assume user has file. */ +#endif +#endif + +#ifdef sunFortran +#if defined(sun) || defined(__sun) +#include <math.h> /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT. */ +#else +#include "math.h" /* i.e. if crosscompiling assume user has file. */ +#endif +/* At least starting with the default C compiler SC3.0.1 of SunOS 5.3, + * FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in + * <math.h>, since sun C no longer promotes C float return values to doubles. + * Therefore, only use them if defined. + * Even if gcc is being used, assume that it exhibits the Sun C compiler + * behavior in order to be able to use *.o from the Sun C compiler. + * i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc. + */ +#endif + +#ifndef apolloFortran +#define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME +#define CF_NULL_PROTO +#else /* HP doesn't understand #elif. */ +/* Without ANSI prototyping, Apollo promotes float functions to double. */ +/* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */ +#define CF_NULL_PROTO ... +#ifndef __CF__APOLLO67 +#define COMMON_BLOCK_DEF(DEFINITION, NAME) \ + DEFINITION NAME __attribute((__section(NAME))) +#else +#define COMMON_BLOCK_DEF(DEFINITION, NAME) \ + DEFINITION NAME #attribute[section(NAME)] +#endif +#endif + +#ifdef __cplusplus +#undef CF_NULL_PROTO +#define CF_NULL_PROTO ... +#endif + +#ifdef mipsFortran +#define CF_DECLARE_GETARG int f77argc; char **f77argv +#define CF_SET_GETARG(ARGC,ARGV) f77argc = ARGC; f77argv = ARGV +#else +#define CF_DECLARE_GETARG +#define CF_SET_GETARG(ARGC,ARGV) +#endif + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define ACOMMA , +#define ACOLON ; + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES USED WITHIN CFORTRAN.H */ + +#define _cfMIN(A,B) (A<B?A:B) +#ifndef FALSE +#define FALSE (1==0) +#endif + +/* 970211 - XIX.145: + firstindexlength - better name is all_but_last_index_lengths + secondindexlength - better name is last_index_length + */ +#define firstindexlength(A) (sizeof(A[0])==1 ? 1 : (sizeof(A) / sizeof(A[0])) ) +#define secondindexlength(A) (sizeof(A[0])==1 ? sizeof(A) : sizeof(A[0]) ) + +/* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int. +Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV. +f2c, MIPS f77 [DECstation, SGI], VAX Ultrix f77, +HP-UX f77 : as in C. +VAX/VMS FORTRAN, VAX Ultrix fort, +Absoft Unix Fortran, IBM RS/6000 xlf : LS Bit = 0/1 = TRUE/FALSE. +Apollo : neg. = TRUE, else FALSE. +[Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.] +[DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.] +[MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/ + +#if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran) || defined(PowerStationFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(SXFortran) +/* SX/PowerStationFortran have 0 and 1 defined, others are neither T nor F. */ +/* hpuxFortran800 has 0 and 0x01000000 defined. Others are unknown. */ +#define LOGICAL_STRICT /* Other Fortran have .eqv./.neqv. == .eq./.ne. */ +#endif + +#define C2FLOGICALV(A,I) \ + do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (FALSE) +#define F2CLOGICALV(A,I) \ + do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (FALSE) + +#if defined(apolloFortran) +#define C2FLOGICAL(L) ((L)?-1:(L)&~((unsigned)1<<sizeof(int)*8-1)) +#define F2CLOGICAL(L) ((L)<0?(L):0) +#else +#if defined(CRAYFortran) +#define C2FLOGICAL(L) _btol(L) +#define F2CLOGICAL(L) _ltob(&(L)) /* Strangely _ltob() expects a pointer. */ +#else +#if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran) || defined(AbsoftUNIXFortran) +#define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1) +#define F2CLOGICAL(L) ((L)&1?(L):0) +#else +#if defined(CONVEXFortran) +#define C2FLOGICAL(L) ((L) ? ~0 : 0 ) +#define F2CLOGICAL(L) (L) +#else /* others evaluate LOGICALs as for C. */ +#define C2FLOGICAL(L) (L) +#define F2CLOGICAL(L) (L) +#ifndef LOGICAL_STRICT +#undef C2FLOGICALV +#undef F2CLOGICALV +#define C2FLOGICALV(A,I) +#define F2CLOGICALV(A,I) +#endif /* LOGICAL_STRICT */ +#endif /* CONVEXFortran || All Others */ +#endif /* IBMR2Fortran vmsFortran DECFortran AbsoftUNIXFortran */ +#endif /* CRAYFortran */ +#endif /* apolloFortran */ + +/* 970514 - In addition to CRAY, there may be other machines + for which LOGICAL_STRICT makes no sense. */ +#if defined(LOGICAL_STRICT) && !defined(CRAYFortran) +/* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE. + SX/PowerStationFortran only have 0 and 1 defined. + Elsewhere, only needed if you want to do: + logical lvariable + if (lvariable .eq. .true.) then ! (1) + instead of + if (lvariable .eqv. .true.) then ! (2) + - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf + refuse to compile (1), so you are probably well advised to stay away from + (1) and from LOGICAL_STRICT. + - You pay a (slight) performance penalty for using LOGICAL_STRICT. */ +#undef C2FLOGICAL +#ifdef hpuxFortran800 +#define C2FLOGICAL(L) ((L)?0x01000000:0) +#else +#if defined(apolloFortran) || defined(vmsFortran) || defined(DECFortran) +#define C2FLOGICAL(L) ((L)?-1:0) /* These machines use -1/0 for .true./.false.*/ +#else +#define C2FLOGICAL(L) ((L)? 1:0) /* All others use +1/0 for .true./.false.*/ +#endif +#endif +#endif /* LOGICAL_STRICT */ + +/* Convert a vector of C strings into FORTRAN strings. */ +#ifndef __CF__KnR +static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr) +#else +static char *c2fstrv( cstr, fstr, elem_len, sizeofcstr) + char* cstr; char *fstr; int elem_len; int sizeofcstr; +#endif +{ int i,j; +/* elem_len includes \0 for C strings. Fortran strings don't have term. \0. + Useful size of string must be the same in both languages. */ +for (i=0; i<sizeofcstr/elem_len; i++) { + for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++; + cstr += 1+elem_len-j; + for (; j<elem_len; j++) *fstr++ = ' '; +} /* 95109 - Seems to be returning the original fstr. */ +return fstr-sizeofcstr+sizeofcstr/elem_len; } + +/* Convert a vector of FORTRAN strings into C strings. */ +#ifndef __CF__KnR +static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr) +#else +static char *f2cstrv( fstr, cstr, elem_len, sizeofcstr) + char *fstr; char* cstr; int elem_len; int sizeofcstr; +#endif +{ int i,j; +/* elem_len includes \0 for C strings. Fortran strings don't have term. \0. + Useful size of string must be the same in both languages. */ +cstr += sizeofcstr; +fstr += sizeofcstr - sizeofcstr/elem_len; +for (i=0; i<sizeofcstr/elem_len; i++) { + *--cstr = '\0'; + for (j=1; j<elem_len; j++) *--cstr = *--fstr; +} return cstr; } + +/* kill the trailing char t's in string s. */ +#ifndef __CF__KnR +static char *kill_trailing(char *s, char t) +#else +static char *kill_trailing( s, t) char *s; char t; +#endif +{char *e; +e = s + strlen(s); +if (e>s) { /* Need this to handle NULL string.*/ + while (e>s && *--e==t); /* Don't follow t's past beginning. */ + e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */ +} return s; } + +/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally +points to the terminating '\0' of s, but may actually point to anywhere in s. +s's new '\0' will be placed at e or earlier in order to remove any trailing t's. +If e<s string s is left unchanged. */ +#ifndef __CF__KnR +static char *kill_trailingn(char *s, char t, char *e) +#else +static char *kill_trailingn( s, t, e) char *s; char t; char *e; +#endif +{ +if (e==s) *e = '\0'; /* Kill the string makes sense here.*/ +else if (e>s) { /* Watch out for neg. length string.*/ + while (e>s && *--e==t); /* Don't follow t's past beginning. */ + e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */ +} return s; } + +/* Note the following assumes that any element which has t's to be chopped off, +does indeed fill the entire element. */ +#ifndef __CF__KnR +static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t) +#else +static char *vkill_trailing( cstr, elem_len, sizeofcstr, t) + char* cstr; int elem_len; int sizeofcstr; char t; +#endif +{ int i; +for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */ + kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1); +return cstr; } + +#ifdef vmsFortran +typedef struct dsc$descriptor_s fstring; +#define DSC$DESCRIPTOR_A(DIMCT) \ +struct { \ + unsigned short dsc$w_length; unsigned char dsc$b_dtype; \ + unsigned char dsc$b_class; char *dsc$a_pointer; \ + char dsc$b_scale; unsigned char dsc$b_digits; \ + struct { \ + unsigned : 3; unsigned dsc$v_fl_binscale : 1; \ + unsigned dsc$v_fl_redim : 1; unsigned dsc$v_fl_column : 1; \ + unsigned dsc$v_fl_coeff : 1; unsigned dsc$v_fl_bounds : 1; \ + } dsc$b_aflags; \ + unsigned char dsc$b_dimct; unsigned long dsc$l_arsize; \ + char *dsc$a_a0; long dsc$l_m [DIMCT]; \ + struct { \ + long dsc$l_l; long dsc$l_u; \ + } dsc$bounds [DIMCT]; \ +} + +typedef DSC$DESCRIPTOR_A(1) fstringvector; +/*typedef DSC$DESCRIPTOR_A(2) fstringarrarr; + typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/ +#define initfstr(F,C,ELEMNO,ELEMLEN) \ +( (F).dsc$l_arsize= ( (F).dsc$w_length =(ELEMLEN) ) \ + *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO) ), \ + (F).dsc$a_a0 = ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length ,(F)) + +#endif /* PDW: 2/10/98 -- Let VMS see NUM_ELEMS definitions */ +#define _NUM_ELEMS -1 +#define _NUM_ELEM_ARG -2 +#define NUM_ELEMS(A) A,_NUM_ELEMS +#define NUM_ELEM_ARG(B) *_2(A,B),_NUM_ELEM_ARG +#define TERM_CHARS(A,B) A,B +#ifndef __CF__KnR +static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term) +#else +static int num_elem( strv, elem_len, term_char, num_term) + char *strv; unsigned elem_len; int term_char; int num_term; +#endif +/* elem_len is the number of characters in each element of strv, the FORTRAN +vector of strings. The last element of the vector must begin with at least +num_term term_char characters, so that this routine can determine how +many elements are in the vector. */ +{ +unsigned num,i; +if (num_term == _NUM_ELEMS || num_term == _NUM_ELEM_ARG) + return term_char; +if (num_term <=0) num_term = (int)elem_len; +for (num=0; ; num++) { + for (i=0; i<(unsigned)num_term && *strv==term_char; i++,strv++); + if (i==(unsigned)num_term) break; + else strv += elem_len-i; +} +return (int)num; +} + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS */ + +/* C string TO Fortran Common Block STRing. */ +/* DIM is the number of DIMensions of the array in terms of strings, not + characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */ +#define C2FCBSTR(CSTR,FSTR,DIM) \ + c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \ + sizeof(FSTR)+cfelementsof(FSTR,DIM)) + +/* Fortran Common Block string TO C STRing. */ +#define FCB2CSTR(FSTR,CSTR,DIM) \ + vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR, \ + sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \ + sizeof(FSTR)+cfelementsof(FSTR,DIM)), \ + sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \ + sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ') + +#define cfDEREFERENCE0 +#define cfDEREFERENCE1 * +#define cfDEREFERENCE2 ** +#define cfDEREFERENCE3 *** +#define cfDEREFERENCE4 **** +#define cfDEREFERENCE5 ***** +#define cfelementsof(A,D) (sizeof(A)/sizeof(_(cfDEREFERENCE,D)(A))) + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR C TO CALL FORTRAN SUBROUTINES */ + +/* Define lookup tables for how to handle the various types of variables. */ + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#define ZTRINGV_NUM(I) I +#define ZTRINGV_ARGFP(I) (*(_2(A,I))) /* Undocumented. For PINT, etc. */ +#define ZTRINGV_ARGF(I) _2(A,I) +#ifdef CFSUBASFUN +#define ZTRINGV_ARGS(I) ZTRINGV_ARGF(I) +#else +#define ZTRINGV_ARGS(I) _2(B,I) +#endif + +#define PBYTE_cfVP(A,B) PINT_cfVP(A,B) +#define PDOUBLE_cfVP(A,B) +#define PFLOAT_cfVP(A,B) +#ifdef ZTRINGV_ARGS_allows_Pvariables +/* This allows Pvariables for ARGS. ARGF machinery is above ARGFP. + * B is not needed because the variable may be changed by the Fortran routine, + * but because B is the only way to access an arbitrary macro argument. */ +#define PINT_cfVP(A,B) int B = (int)A; /* For ZSTRINGV_ARGS */ +#else +#define PINT_cfVP(A,B) +#endif +#define PLOGICAL_cfVP(A,B) int *B; /* Returning LOGICAL in FUNn and SUBn */ +#define PLONG_cfVP(A,B) PINT_cfVP(A,B) +#define PSHORT_cfVP(A,B) PINT_cfVP(A,B) + +#define VCF_INT_S(T,A,B) _(T,VVVVVVV_cfTYPE) B = A; +#define VCF_INT_F(T,A,B) _(T,_cfVCF)(A,B) +/* _cfVCF table is directly mapped to _cfCCC table. */ +#define BYTE_cfVCF(A,B) +#define DOUBLE_cfVCF(A,B) +#if !defined(__CF__KnR) +#define FLOAT_cfVCF(A,B) +#else +#define FLOAT_cfVCF(A,B) FORTRAN_REAL B = A; +#endif +#define INT_cfVCF(A,B) +#define LOGICAL_cfVCF(A,B) +#define LONG_cfVCF(A,B) +#define SHORT_cfVCF(A,B) + +#define VCF(TN,I) _Icf4(4,V,TN,_(A,I),_(B,I),F) +#define VVCF(TN,AI,BI) _Icf4(4,V,TN,AI,BI,S) +#define INT_cfV(T,A,B,F) _(VCF_INT_,F)(T,A,B) +#define INTV_cfV(T,A,B,F) +#define INTVV_cfV(T,A,B,F) +#define INTVVV_cfV(T,A,B,F) +#define INTVVVV_cfV(T,A,B,F) +#define INTVVVVV_cfV(T,A,B,F) +#define INTVVVVVV_cfV(T,A,B,F) +#define INTVVVVVVV_cfV(T,A,B,F) +#define PINT_cfV( T,A,B,F) _(T,_cfVP)(A,B) +#define PVOID_cfV( T,A,B,F) +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfV(T,A,B,F) void (*B)(CF_NULL_PROTO) = (void (*)(CF_NULL_PROTO))A; +#else +#define ROUTINE_cfV(T,A,B,F) +#endif +#define SIMPLE_cfV(T,A,B,F) +#ifdef vmsFortran +#define STRING_cfV(T,A,B,F) static struct {fstring f; unsigned clen;} B = \ + {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0}; +#define PSTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL}; +#define STRINGV_cfV(T,A,B,F) static fstringvector B = \ + {sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}}; +#define PSTRINGV_cfV(T,A,B,F) static fstringvector B = \ + {0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}}; +#else +#define STRING_cfV(T,A,B,F) struct {unsigned int clen, flen;} B; +#define STRINGV_cfV(T,A,B,F) struct {char *s, *fs; unsigned flen;} B; +#define PSTRING_cfV(T,A,B,F) int B; +#define PSTRINGV_cfV(T,A,B,F) struct{char *fs; unsigned int sizeofA,flen;}B; +#endif +#define ZTRINGV_cfV(T,A,B,F) STRINGV_cfV(T,A,B,F) +#define PZTRINGV_cfV(T,A,B,F) PSTRINGV_cfV(T,A,B,F) + +/* Note that the actions of the A table were performed inside the AA table. + VAX Ultrix vcc, and HP-UX cc, didn't evaluate arguments to functions left to + right, so we had to split the original table into the current robust two. */ +#define ACF(NAME,TN,AI,I) _(TN,_cfSTR)(4,A,NAME,I,AI,_(B,I),0) +#define DEFAULT_cfA(M,I,A,B) +#define LOGICAL_cfA(M,I,A,B) B=C2FLOGICAL(B); +#define PLOGICAL_cfA(M,I,A,B) A=C2FLOGICAL(A); +#define STRING_cfA(M,I,A,B) STRING_cfC(M,I,A,B,sizeof(A)) +#define PSTRING_cfA(M,I,A,B) PSTRING_cfC(M,I,A,B,sizeof(A)) +#ifdef vmsFortran +#define AATRINGV_cfA( A,B, sA,filA,silA) \ + initfstr(B,(char *)malloc((sA)-(filA)),(filA),(silA)-1), \ + c2fstrv(A,B.dsc$a_pointer,(silA),(sA)); +#define APATRINGV_cfA( A,B, sA,filA,silA) \ + initfstr(B,A,(filA),(silA)-1),c2fstrv(A,A,(silA),(sA)); +#else +#define AATRINGV_cfA( A,B, sA,filA,silA) \ + (B.s=(char *)malloc((sA)-(filA)),B.fs=c2fstrv(A,B.s,(B.flen=(silA)-1)+1,(sA))); +#define APATRINGV_cfA( A,B, sA,filA,silA) \ + B.fs=c2fstrv(A,A,(B.flen=(silA)-1)+1,B.sizeofA=(sA)); +#endif +#define STRINGV_cfA(M,I,A,B) \ + AATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A)) +#define PSTRINGV_cfA(M,I,A,B) \ + APATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A)) +#define ZTRINGV_cfA(M,I,A,B) AATRINGV_cfA( (char *)A,B, \ + (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1) +#define PZTRINGV_cfA(M,I,A,B) APATRINGV_cfA( (char *)A,B, \ + (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1) + +#define PBYTE_cfAAP(A,B) &A +#define PDOUBLE_cfAAP(A,B) &A +#define PFLOAT_cfAAP(A,B) FLOATVVVVVVV_cfPP &A +#define PINT_cfAAP(A,B) &A +#define PLOGICAL_cfAAP(A,B) B= &A /* B used to keep a common W table. */ +#define PLONG_cfAAP(A,B) &A +#define PSHORT_cfAAP(A,B) &A + +#define AACF(TN,AI,I,C) _SEP_(TN,C,COMMA) _Icf(3,AA,TN,AI,_(B,I)) +#define INT_cfAA(T,A,B) &B +#define INTV_cfAA(T,A,B) _(T,VVVVVV_cfPP) A +#define INTVV_cfAA(T,A,B) _(T,VVVVV_cfPP) A[0] +#define INTVVV_cfAA(T,A,B) _(T,VVVV_cfPP) A[0][0] +#define INTVVVV_cfAA(T,A,B) _(T,VVV_cfPP) A[0][0][0] +#define INTVVVVV_cfAA(T,A,B) _(T,VV_cfPP) A[0][0][0][0] +#define INTVVVVVV_cfAA(T,A,B) _(T,V_cfPP) A[0][0][0][0][0] +#define INTVVVVVVV_cfAA(T,A,B) _(T,_cfPP) A[0][0][0][0][0][0] +#define PINT_cfAA(T,A,B) _(T,_cfAAP)(A,B) +#define PVOID_cfAA(T,A,B) (void *) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfAA(T,A,B) &B +#else +#define ROUTINE_cfAA(T,A,B) (void(*)(CF_NULL_PROTO))A +#endif +#define STRING_cfAA(T,A,B) STRING_cfCC(T,A,B) +#define PSTRING_cfAA(T,A,B) PSTRING_cfCC(T,A,B) +#ifdef vmsFortran +#define STRINGV_cfAA(T,A,B) &B +#else +#ifdef CRAYFortran +#define STRINGV_cfAA(T,A,B) _cptofcd(B.fs,B.flen) +#else +#define STRINGV_cfAA(T,A,B) B.fs +#endif +#endif +#define PSTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B) +#define ZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B) +#define PZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B) + +#if defined(vmsFortran) || defined(CRAYFortran) +#define JCF(TN,I) +#define KCF(TN,I) +#else +#define JCF(TN,I) _(TN,_cfSTR)(1,J,_(B,I), 0,0,0,0) +#if defined(AbsoftUNIXFortran) +#define DEFAULT_cfJ(B) ,0 +#else +#define DEFAULT_cfJ(B) +#endif +#define LOGICAL_cfJ(B) DEFAULT_cfJ(B) +#define PLOGICAL_cfJ(B) DEFAULT_cfJ(B) +#define STRING_cfJ(B) ,B.flen +#define PSTRING_cfJ(B) ,B +#define STRINGV_cfJ(B) STRING_cfJ(B) +#define PSTRINGV_cfJ(B) STRING_cfJ(B) +#define ZTRINGV_cfJ(B) STRING_cfJ(B) +#define PZTRINGV_cfJ(B) STRING_cfJ(B) + +/* KCF is identical to DCF, except that KCF ZTRING is not empty. */ +#define KCF(TN,I) _(TN,_cfSTR)(1,KK,_(B,I), 0,0,0,0) +#if defined(AbsoftUNIXFortran) +#define DEFAULT_cfKK(B) , unsigned B +#else +#define DEFAULT_cfKK(B) +#endif +#define LOGICAL_cfKK(B) DEFAULT_cfKK(B) +#define PLOGICAL_cfKK(B) DEFAULT_cfKK(B) +#define STRING_cfKK(B) , unsigned B +#define PSTRING_cfKK(B) STRING_cfKK(B) +#define STRINGV_cfKK(B) STRING_cfKK(B) +#define PSTRINGV_cfKK(B) STRING_cfKK(B) +#define ZTRINGV_cfKK(B) STRING_cfKK(B) +#define PZTRINGV_cfKK(B) STRING_cfKK(B) +#endif + +#define WCF(TN,AN,I) _(TN,_cfSTR)(2,W,AN,_(B,I), 0,0,0) +#define DEFAULT_cfW(A,B) +#define LOGICAL_cfW(A,B) +#define PLOGICAL_cfW(A,B) *B=F2CLOGICAL(*B); +#define STRING_cfW(A,B) (A[B.clen]!='\0'?A[B.clen]='\0':0); /* A?="constnt"*/ +#define PSTRING_cfW(A,B) kill_trailing(A,' '); +#ifdef vmsFortran +#define STRINGV_cfW(A,B) free(B.dsc$a_pointer); +#define PSTRINGV_cfW(A,B) \ + vkill_trailing(f2cstrv((char*)A, (char*)A, \ + B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]), \ + B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' '); +#else +#define STRINGV_cfW(A,B) free(B.s); +#define PSTRINGV_cfW(A,B) vkill_trailing( \ + f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' '); +#endif +#define ZTRINGV_cfW(A,B) STRINGV_cfW(A,B) +#define PZTRINGV_cfW(A,B) PSTRINGV_cfW(A,B) + +#define NCF(TN,I,C) _SEP_(TN,C,COMMA) _Icf(2,N,TN,_(A,I),0) +#define NNCF(TN,I,C) UUCF(TN,I,C) +#define NNNCF(TN,I,C) _SEP_(TN,C,COLON) _Icf(2,N,TN,_(A,I),0) +#define INT_cfN(T,A) _(T,VVVVVVV_cfTYPE) * A +#define INTV_cfN(T,A) _(T,VVVVVV_cfTYPE) * A +#define INTVV_cfN(T,A) _(T,VVVVV_cfTYPE) * A +#define INTVVV_cfN(T,A) _(T,VVVV_cfTYPE) * A +#define INTVVVV_cfN(T,A) _(T,VVV_cfTYPE) * A +#define INTVVVVV_cfN(T,A) _(T,VV_cfTYPE) * A +#define INTVVVVVV_cfN(T,A) _(T,V_cfTYPE) * A +#define INTVVVVVVV_cfN(T,A) _(T,_cfTYPE) * A +#define PINT_cfN(T,A) _(T,_cfTYPE) * A +#define PVOID_cfN(T,A) void * A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfN(T,A) void (**A)(CF_NULL_PROTO) +#else +#define ROUTINE_cfN(T,A) void ( *A)(CF_NULL_PROTO) +#endif +#ifdef vmsFortran +#define STRING_cfN(T,A) fstring * A +#define STRINGV_cfN(T,A) fstringvector * A +#else +#ifdef CRAYFortran +#define STRING_cfN(T,A) _fcd A +#define STRINGV_cfN(T,A) _fcd A +#else +#define STRING_cfN(T,A) char * A +#define STRINGV_cfN(T,A) char * A +#endif +#endif +#define PSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */ +#define PNSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */ +#define PPSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */ +#define PSTRINGV_cfN(T,A) STRINGV_cfN(T,A) +#define ZTRINGV_cfN(T,A) STRINGV_cfN(T,A) +#define PZTRINGV_cfN(T,A) PSTRINGV_cfN(T,A) + + +/* Apollo 6.7, CRAY, old Sun, VAX/Ultrix vcc/cc and new ultrix + can't hack more than 31 arg's. + e.g. ultrix >= 4.3 gives message: + zow35> cc -c -DDECFortran cfortest.c + cfe: Fatal: Out of memory: cfortest.c + zow35> + Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine + if using -Aa, otherwise we have a problem. + */ +#ifndef MAX_PREPRO_ARGS +#if !defined(__GNUC__) && (defined(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR))) +#define MAX_PREPRO_ARGS 31 +#else +#define MAX_PREPRO_ARGS 99 +#endif +#endif + +#if defined(AbsoftUNIXFortran) +/* In addition to explicit Absoft stuff, only Absoft requires: + - DEFAULT coming from _cfSTR. + DEFAULT could have been called e.g. INT, but keep it for clarity. + - M term in CFARGT14 and CFARGT14FS. + */ +#define ABSOFT_cf1(T0) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0) +#define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0) +#define ABSOFT_cf3(T0) _(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0) +#define DEFAULT_cfABSOFT1 +#define LOGICAL_cfABSOFT1 +#define STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING +#define DEFAULT_cfABSOFT2 +#define LOGICAL_cfABSOFT2 +#define STRING_cfABSOFT2 ,unsigned D0 +#define DEFAULT_cfABSOFT3 +#define LOGICAL_cfABSOFT3 +#define STRING_cfABSOFT3 ,D0 +#else +#define ABSOFT_cf1(T0) +#define ABSOFT_cf2(T0) +#define ABSOFT_cf3(T0) +#endif + +/* _Z introduced to cicumvent IBM and HP silly preprocessor warning. + e.g. "Macro CFARGT14 invoked with a null argument." + */ +#define _Z + +#define CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,A) S(TB,B) S(TC,C) S(TD,D) S(TE,E) +#define CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,A,1) F(TB,B,1) F(TC,C,1) F(TD,D,1) F(TE,E,1) \ + M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) + +#if !(defined(PowerStationFortran)||defined(hpuxFortran800)) +/* Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields: + SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c + "c.c", line 406: warning: argument mismatch + Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok. + Behavior is most clearly seen in example: + #define A 1 , 2 + #define C(X,Y,Z) x=X. y=Y. z=Z. + #define D(X,Y,Z) C(X,Y,Z) + D(x,A,z) + Output from preprocessor is: x = x . y = 1 . z = 2 . + #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +*/ +#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \ + F(T8,8,1) F(T9,9,1) F(TA,A,1) F(TB,B,1) F(TC,C,1) F(TD,D,1) F(TE,E,1) \ + M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +/* F changed to Z for arg 15. Watch out if ever extend to S or Z arguments. */ +#define CFARGT20(Z,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + Z(T1,1,0) Z(T2,2,1) Z(T3,3,1) Z(T4,4,1) Z(T5,5,1) Z(T6,6,1) Z(T7,7,1) \ + Z(T8,8,1) Z(T9,9,1) Z(TA,A,1) Z(TB,B,1) Z(TC,C,1) Z(TD,D,1) Z(TE,E,1) \ + Z(TF,F,1) Z(TG,G,1) Z(TH,H,1) Z(TI,I,1) Z(TJ,J,1) Z(TK,K,1) \ + S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \ + S(T8,8) S(T9,9) S(TA,A) S(TB,B) S(TC,C) S(TD,D) S(TE,E) \ + S(TF,F) S(TG,G) S(TH,H) S(TI,I) S(TJ,J) S(TK,K) +#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \ + F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \ + F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,A,1) F(TB,AB,B,1) F(TC,AC,C,1) \ + F(TD,AD,D,1) F(TE,AE,E,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \ + S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,A) \ + S(TB,B) S(TC,C) S(TD,D) S(TE,E) +#if MAX_PREPRO_ARGS>31 +/* F changed to Z for arg 15. Watch out if ever extend to S or Z arguments. */ +#define CFARGTA20(Z,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ + Z(T1,A1,1,0) Z(T2,A2,2,1) Z(T3,A3,3,1) Z(T4,A4,4,1) Z(T5,A5,5,1) Z(T6,A6,6,1) \ + Z(T7,A7,7,1) Z(T8,A8,8,1) Z(T9,A9,9,1) Z(TA,AA,A,1) Z(TB,AB,B,1) Z(TC,AC,C,1) \ + Z(TD,AD,D,1) Z(TE,AE,E,1) Z(TF,AF,F,1) Z(TG,AG,G,1) Z(TH,AH,H,1) Z(TI,AI,I,1) \ + Z(TJ,AJ,J,1) Z(TK,AK,K,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \ + S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,A) \ + S(TB,B) S(TC,C) S(TD,D) S(TE,E) S(TF,F) S(TG,G) \ + S(TH,H) S(TI,I) S(TJ,J) S(TK,K) +#endif +#else +#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \ + F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \ + F(T9,9,1) S(T9,9) F(TA,A,1) S(TA,A) F(TB,B,1) S(TB,B) F(TC,C,1) S(TC,C) \ + F(TD,D,1) S(TD,D) F(TE,E,1) S(TE,E) +/* F changed to Z for arg 15. Watch out if ever extend to S or Z arguments. */ +#define CFARGT20(Z,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + Z(T1,1,0) S(T1,1) Z(T2,2,1) S(T2,2) Z(T3,3,1) S(T3,3) Z(T4,4,1) S(T4,4) \ + Z(T5,5,1) S(T5,5) Z(T6,6,1) S(T6,6) Z(T7,7,1) S(T7,7) Z(T8,8,1) S(T8,8) \ + Z(T9,9,1) S(T9,9) Z(TA,A,1) S(TA,A) Z(TB,B,1) S(TB,B) Z(TC,C,1) S(TC,C) \ + Z(TD,D,1) S(TD,D) Z(TE,E,1) S(TE,E) Z(TF,F,1) S(TF,F) Z(TG,G,1) S(TG,G) \ + Z(TH,H,1) S(TH,H) Z(TI,I,1) S(TI,I) Z(TJ,J,1) S(TJ,J) Z(TK,K,1) S(TK,K) +#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \ + F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \ + F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \ + F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \ + F(TA,AA,A,1) S(TA,A) F(TB,AB,B,1) S(TB,B) F(TC,AC,C,1) S(TC,C) \ + F(TD,AD,D,1) S(TD,D) F(TE,AE,E,1) S(TE,E) +#if MAX_PREPRO_ARGS>31 +/* F changed to Z for arg 15. Watch out if ever extend to S or Z arguments. */ +#define CFARGTA20(Z,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ + Z(T1,A1,1,0) S(T1,1) Z(T2,A2,2,1) S(T2,2) Z(T3,A3,3,1) S(T3,3) \ + Z(T4,A4,4,1) S(T4,4) Z(T5,A5,5,1) S(T5,5) Z(T6,A6,6,1) S(T6,6) \ + Z(T7,A7,7,1) S(T7,7) Z(T8,A8,8,1) S(T8,8) Z(T9,A9,9,1) S(T9,9) \ + Z(TA,AA,A,1) S(TA,A) Z(TB,AB,B,1) S(TB,B) Z(TC,AC,C,1) S(TC,C) \ + Z(TD,AD,D,1) S(TD,D) Z(TE,AE,E,1) S(TE,E) Z(TF,AF,F,1) S(TF,F) \ + Z(TG,AG,G,1) S(TG,G) Z(TH,AH,H,1) S(TH,H) Z(TI,AI,I,1) S(TI,I) \ + Z(TJ,AJ,J,1) S(TJ,J) Z(TK,AK,K,1) S(TK,K) +#endif +#endif + + +#define PROTOCCALLSFSUB1( UN,LN,T1) \ + PROTOCCALLSFSUB14(UN,LN,T1,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB2( UN,LN,T1,T2) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB3( UN,LN,T1,T2,T3) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB4( UN,LN,T1,T2,T3,T4) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define PROTOCCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + + +#define PROTOCCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0) +#define PROTOCCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0) +#define PROTOCCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0) + + +#ifndef FCALLSC_QUALIFIER +#ifdef VISUAL_CPLUSPLUS +#define FCALLSC_QUALIFIER __stdcall +#else +#define FCALLSC_QUALIFIER +#endif +#endif + +#ifdef __cplusplus +#define CFextern extern "C" +#else +#define CFextern extern +#endif + + +#ifdef CFSUBASFUN +#define PROTOCCALLSFSUB0(UN,LN) \ + PROTOCCALLSFFUN0( VOID,UN,LN) +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFFUN14(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\ + PROTOCCALLSFFUN20(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#else +/* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after + #include-ing cfortran.h if calling the FORTRAN wrapper within the same + source code where the wrapper is created. */ +#define PROTOCCALLSFSUB0(UN,LN) CFextern void FCALLSC_QUALIFIER CFC_(UN,LN)(); +#ifndef __CF__KnR +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern void FCALLSC_QUALIFIER CFC_(UN,LN)( CFARGT14(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ); +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\ + CFextern void FCALLSC_QUALIFIER CFC_(UN,LN)( CFARGT20(NCF,KCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) ); +#else +#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFSUB0(UN,LN) +#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + PROTOCCALLSFSUB0(UN,LN) +#endif +#endif + + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + + +#define CCALLSFSUB1( UN,LN,T1, A1) \ + CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0) +#define CCALLSFSUB2( UN,LN,T1,T2, A1,A2) \ + CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0) +#define CCALLSFSUB3( UN,LN,T1,T2,T3, A1,A2,A3) \ + CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0) +#define CCALLSFSUB4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\ + CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0) +#define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0) +#define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0) +#define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0) +#define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0) +#define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\ + CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0) +#define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0) +#define CCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0) +#define CCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0) +#define CCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\ + CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0) + +#ifdef __cplusplus +#define CPPPROTOCLSFSUB0( UN,LN) +#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#else +#define CPPPROTOCLSFSUB0(UN,LN) \ + PROTOCCALLSFSUB0(UN,LN) +#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) +#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) +#endif + +#ifdef CFSUBASFUN +#define CCALLSFSUB0(UN,LN) CCALLSFFUN0(UN,LN) +#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) +#else +/* do{...}while(FALSE) allows if(a==b) FORT(); else BORT(); */ +#define CCALLSFSUB0( UN,LN) do{CPPPROTOCLSFSUB0(UN,LN) CFC_(UN,LN)();}while(FALSE) +#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,BA) \ + VVCF(TB,AB,BB) VVCF(TC,AC,BC) VVCF(TD,AD,BD) VVCF(TE,AE,BE) \ + CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) \ + ACF(LN,T4,A4,4) ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) \ + ACF(LN,T8,A8,8) ACF(LN,T9,A9,9) ACF(LN,TA,AA,A) ACF(LN,TB,AB,B) \ + ACF(LN,TC,AC,C) ACF(LN,TD,AD,D) ACF(LN,TE,AE,E) \ + CFC_(UN,LN)( CFARGTA14(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) );\ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) \ + WCF(TB,AB,B) WCF(TC,AC,C) WCF(TD,AD,D) WCF(TE,AE,E) }while(FALSE) +#endif + + +#if MAX_PREPRO_ARGS>31 +#define CCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,0,0,0,0,0) +#define CCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,0,0,0,0) +#define CCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,0,0,0) +#define CCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,0,0) +#define CCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ)\ + CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,0) + +#ifdef CFSUBASFUN +#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \ + TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ + CCALLSFFUN20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \ + TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) +#else +#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \ + TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \ +do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \ + VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,BA) \ + VVCF(TB,AB,BB) VVCF(TC,AC,BC) VVCF(TD,AD,BD) VVCF(TE,AE,BE) VVCF(TF,AF,BF) \ + VVCF(TG,AG,BG) VVCF(TH,AH,BH) VVCF(TI,AI,BI) VVCF(TJ,AJ,BJ) VVCF(TK,AK,BK) \ + CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \ + ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \ + ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \ + ACF(LN,T9,A9,9) ACF(LN,TA,AA,A) ACF(LN,TB,AB,B) ACF(LN,TC,AC,C) \ + ACF(LN,TD,AD,D) ACF(LN,TE,AE,E) ACF(LN,TF,AF,F) ACF(LN,TG,AG,G) \ + ACF(LN,TH,AH,H) ACF(LN,TI,AI,I) ACF(LN,TJ,AJ,J) ACF(LN,TK,AK,K) \ + CFC_(UN,LN)( CFARGTA20(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) ); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \ + WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) WCF(TB,AB,B) WCF(TC,AC,C) \ + WCF(TD,AD,D) WCF(TE,AE,E) WCF(TF,AF,F) WCF(TG,AG,G) WCF(TH,AH,H) WCF(TI,AI,I) \ + WCF(TJ,AJ,J) WCF(TK,AK,K) }while(FALSE) +#endif +#endif /* MAX_PREPRO_ARGS */ + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR C TO CALL FORTRAN FUNCTIONS */ + +/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN + function is called. Therefore, especially for creator's of C header files + for large FORTRAN libraries which include many functions, to reduce + compile time and object code size, it may be desirable to create + preprocessor directives to allow users to create code for only those + functions which they use. */ + +/* The following defines the maximum length string that a function can return. + Of course it may be undefine-d and re-define-d before individual + PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived + from the individual machines' limits. */ +#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE + +/* The following defines a character used by CFORTRAN.H to flag the end of a + string coming out of a FORTRAN routine. */ +#define CFORTRAN_NON_CHAR 0x7F + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#define _SEP_(TN,C,COMMA) _(__SEP_,C)(TN,COMMA) +#define __SEP_0(TN,COMMA) +#define __SEP_1(TN,COMMA) _Icf(2,SEP,TN,COMMA,0) +#define INT_cfSEP(T,B) _(A,B) +#define INTV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define INTVVVVVVV_cfSEP(T,B) INT_cfSEP(T,B) +#define PINT_cfSEP(T,B) INT_cfSEP(T,B) +#define PVOID_cfSEP(T,B) INT_cfSEP(T,B) +#define ROUTINE_cfSEP(T,B) INT_cfSEP(T,B) +#define SIMPLE_cfSEP(T,B) INT_cfSEP(T,B) +#define VOID_cfSEP(T,B) INT_cfSEP(T,B) /* For FORTRAN calls C subr.s.*/ +#define STRING_cfSEP(T,B) INT_cfSEP(T,B) +#define STRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define PSTRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PNSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define PPSTRING_cfSEP(T,B) INT_cfSEP(T,B) +#define ZTRINGV_cfSEP(T,B) INT_cfSEP(T,B) +#define PZTRINGV_cfSEP(T,B) INT_cfSEP(T,B) + +#if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE) +#ifdef OLD_VAXC +#define INTEGER_BYTE char /* Old VAXC barfs on 'signed char' */ +#else +#define INTEGER_BYTE signed char /* default */ +#endif +#else +#define INTEGER_BYTE unsigned char +#endif +#define BYTEVVVVVVV_cfTYPE INTEGER_BYTE +#define DOUBLEVVVVVVV_cfTYPE DOUBLE_PRECISION +#define FLOATVVVVVVV_cfTYPE FORTRAN_REAL +#define INTVVVVVVV_cfTYPE int +#define LOGICALVVVVVVV_cfTYPE int +#define LONGVVVVVVV_cfTYPE long +#define SHORTVVVVVVV_cfTYPE short +#define PBYTE_cfTYPE INTEGER_BYTE +#define PDOUBLE_cfTYPE DOUBLE_PRECISION +#define PFLOAT_cfTYPE FORTRAN_REAL +#define PINT_cfTYPE int +#define PLOGICAL_cfTYPE int +#define PLONG_cfTYPE long +#define PSHORT_cfTYPE short + +#define CFARGS0(A,T,V,W,X,Y,Z) _3(T,_cf,A) +#define CFARGS1(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V) +#define CFARGS2(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W) +#define CFARGS3(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X) +#define CFARGS4(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y) +#define CFARGS5(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y,Z) + +#define _Icf(N,T,I,X,Y) _(I,_cfINT)(N,T,I,X,Y,0) +#define _Icf4(N,T,I,X,Y,Z) _(I,_cfINT)(N,T,I,X,Y,Z) +#define BYTE_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define DOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INT,B,X,Y,Z,0) +#define FLOAT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define INT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define LOGICAL_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define LONG_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define SHORT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) +#define PBYTE_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PINT,B,X,Y,Z,0) +#define PFLOAT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PINT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PLOGICAL_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PLONG_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define PSHORT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) +#define BYTEV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define BYTEVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define BYTEVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define DOUBLEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTV,B,X,Y,Z,0) +#define DOUBLEVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVV,B,X,Y,Z,0) +#define DOUBLEVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVV,B,X,Y,Z,0) +#define DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVV,B,X,Y,Z,0) +#define DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVVV,B,X,Y,Z,0) +#define FLOATV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define FLOATVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define FLOATVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define INTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define INTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define INTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LOGICALVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define LONGVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define LONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) +#define SHORTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) +#define SHORTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) +#define PVOID_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,B,B,X,Y,Z,0) +#define ROUTINE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +/*CRAY coughs on the first, + i.e. the usual trouble of not being able to + define macros to macros with arguments. + New ultrix is worse, it coughs on all such uses. + */ +/*#define SIMPLE_cfINT PVOID_cfINT*/ +#define SIMPLE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define VOID_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define STRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define STRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PSTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PNSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PPSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define ZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define PZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z) +#define CF_0_cfINT(N,A,B,X,Y,Z) + + +#define UCF(TN,I,C) _SEP_(TN,C,COMMA) _Icf(2,U,TN,_(A,I),0) +#define UUCF(TN,I,C) _SEP_(TN,C,COMMA) _SEP_(TN,1,I) +#define UUUCF(TN,I,C) _SEP_(TN,C,COLON) _Icf(2,U,TN,_(A,I),0) +#define INT_cfU(T,A) _(T,VVVVVVV_cfTYPE) A +#define INTV_cfU(T,A) _(T,VVVVVV_cfTYPE) * A +#define INTVV_cfU(T,A) _(T,VVVVV_cfTYPE) * A +#define INTVVV_cfU(T,A) _(T,VVVV_cfTYPE) * A +#define INTVVVV_cfU(T,A) _(T,VVV_cfTYPE) * A +#define INTVVVVV_cfU(T,A) _(T,VV_cfTYPE) * A +#define INTVVVVVV_cfU(T,A) _(T,V_cfTYPE) * A +#define INTVVVVVVV_cfU(T,A) _(T,_cfTYPE) * A +#define PINT_cfU(T,A) _(T,_cfTYPE) * A +#define PVOID_cfU(T,A) void *A +#define ROUTINE_cfU(T,A) void (*A)(CF_NULL_PROTO) +#define VOID_cfU(T,A) void A /* Needed for C calls FORTRAN sub.s. */ +#define STRING_cfU(T,A) char *A /* via VOID and wrapper. */ +#define STRINGV_cfU(T,A) char *A +#define PSTRING_cfU(T,A) char *A +#define PSTRINGV_cfU(T,A) char *A +#define ZTRINGV_cfU(T,A) char *A +#define PZTRINGV_cfU(T,A) char *A + +/* VOID breaks U into U and UU. */ +#define INT_cfUU(T,A) _(T,VVVVVVV_cfTYPE) A +#define VOID_cfUU(T,A) /* Needed for FORTRAN calls C sub.s. */ +#define STRING_cfUU(T,A) char *A + + +#define BYTE_cfPU(A) CFextern INTEGER_BYTE FCALLSC_QUALIFIER A +#define DOUBLE_cfPU(A) CFextern DOUBLE_PRECISION FCALLSC_QUALIFIER A +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfPU(A) CFextern FORTRAN_REAL FCALLSC_QUALIFIER A +#else +#define FLOAT_cfPU(A) CFextern FLOATFUNCTIONTYPE FCALLSC_QUALIFIER A +#endif +#define INT_cfPU(A) CFextern int FCALLSC_QUALIFIER A +#define LOGICAL_cfPU(A) CFextern int FCALLSC_QUALIFIER A +#define LONG_cfPU(A) CFextern long FCALLSC_QUALIFIER A +#define SHORT_cfPU(A) CFextern short FCALLSC_QUALIFIER A +#define STRING_cfPU(A) CFextern void FCALLSC_QUALIFIER A +#define VOID_cfPU(A) CFextern void FCALLSC_QUALIFIER A + +#define BYTE_cfE INTEGER_BYTE A0; +#define DOUBLE_cfE DOUBLE_PRECISION A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfE FORTRAN_REAL A0; +#else +#define FLOAT_cfE FORTRAN_REAL AA0; FLOATFUNCTIONTYPE A0; +#endif +#define INT_cfE int A0; +#define LOGICAL_cfE int A0; +#define LONG_cfE long A0; +#define SHORT_cfE short A0; +#define VOID_cfE +#ifdef vmsFortran +#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + static fstring A0 = \ + {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\ + memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\ + *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0'; +#else +#ifdef CRAYFortran +#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\ + memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\ + A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING); +#else +/* 'cc: SC3.0.1 13 Jul 1994' barfs on char A0[0x4FE+1]; + * char A0[0x4FE +1]; char A0[1+0x4FE]; are both OK. */ +#define STRING_cfE static char A0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \ + memset(A0, CFORTRAN_NON_CHAR, \ + MAX_LEN_FORTRAN_FUNCTION_STRING); \ + *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0'; +#endif +#endif +/* ESTRING must use static char. array which is guaranteed to exist after + function returns. */ + +/* N.B.i) The diff. for 0 (Zero) and >=1 arguments. + ii)That the following create an unmatched bracket, i.e. '(', which + must of course be matched in the call. + iii)Commas must be handled very carefully */ +#define INT_cfGZ(T,UN,LN) A0=CFC_(UN,LN)( +#define VOID_cfGZ(T,UN,LN) CFC_(UN,LN)( +#ifdef vmsFortran +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)(&A0 +#else +#if defined(CRAYFortran) || defined(AbsoftUNIXFortran) +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0 +#else +#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING +#endif +#endif + +#define INT_cfG(T,UN,LN) INT_cfGZ(T,UN,LN) +#define VOID_cfG(T,UN,LN) VOID_cfGZ(T,UN,LN) +#define STRING_cfG(T,UN,LN) STRING_cfGZ(T,UN,LN), /*, is only diff. from _cfG*/ + +#define BYTEVVVVVVV_cfPP +#define INTVVVVVVV_cfPP /* These complement FLOATVVVVVVV_cfPP. */ +#define DOUBLEVVVVVVV_cfPP +#define LOGICALVVVVVVV_cfPP +#define LONGVVVVVVV_cfPP +#define SHORTVVVVVVV_cfPP +#define PBYTE_cfPP +#define PINT_cfPP +#define PDOUBLE_cfPP +#define PLOGICAL_cfPP +#define PLONG_cfPP +#define PSHORT_cfPP +#define PFLOAT_cfPP FLOATVVVVVVV_cfPP + +#define BCF(TN,AN,C) _SEP_(TN,C,COMMA) _Icf(2,B,TN,AN,0) +#define INT_cfB(T,A) (_(T,VVVVVVV_cfTYPE)) A +#define INTV_cfB(T,A) A +#define INTVV_cfB(T,A) (A)[0] +#define INTVVV_cfB(T,A) (A)[0][0] +#define INTVVVV_cfB(T,A) (A)[0][0][0] +#define INTVVVVV_cfB(T,A) (A)[0][0][0][0] +#define INTVVVVVV_cfB(T,A) (A)[0][0][0][0][0] +#define INTVVVVVVV_cfB(T,A) (A)[0][0][0][0][0][0] +#define PINT_cfB(T,A) _(T,_cfPP)&A +#define STRING_cfB(T,A) (char *) A +#define STRINGV_cfB(T,A) (char *) A +#define PSTRING_cfB(T,A) (char *) A +#define PSTRINGV_cfB(T,A) (char *) A +#define PVOID_cfB(T,A) (void *) A +#define ROUTINE_cfB(T,A) (void(*)(CF_NULL_PROTO))A +#define ZTRINGV_cfB(T,A) (char *) A +#define PZTRINGV_cfB(T,A) (char *) A + +#define SCF(TN,NAME,I,A) _(TN,_cfSTR)(3,S,NAME,I,A,0,0) +#define DEFAULT_cfS(M,I,A) +#define LOGICAL_cfS(M,I,A) +#define PLOGICAL_cfS(M,I,A) +#define STRING_cfS(M,I,A) ,sizeof(A) +#define STRINGV_cfS(M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \ + +secondindexlength(A)) +#define PSTRING_cfS(M,I,A) ,sizeof(A) +#define PSTRINGV_cfS(M,I,A) STRINGV_cfS(M,I,A) +#define ZTRINGV_cfS(M,I,A) +#define PZTRINGV_cfS(M,I,A) + +#define HCF(TN,I) _(TN,_cfSTR)(3,H,COMMA, H,_(C,I),0,0) +#define HHCF(TN,I) _(TN,_cfSTR)(3,H,COMMA,HH,_(C,I),0,0) +#define HHHCF(TN,I) _(TN,_cfSTR)(3,H,COLON, H,_(C,I),0,0) +#define H_CF_SPECIAL unsigned +#define HH_CF_SPECIAL +#define DEFAULT_cfH(M,I,A) +#define LOGICAL_cfH(S,U,B) +#define PLOGICAL_cfH(S,U,B) +#define STRING_cfH(S,U,B) _(A,S) _(U,_CF_SPECIAL) B +#define STRINGV_cfH(S,U,B) STRING_cfH(S,U,B) +#define PSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define PSTRINGV_cfH(S,U,B) STRING_cfH(S,U,B) +#define PNSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define PPSTRING_cfH(S,U,B) STRING_cfH(S,U,B) +#define ZTRINGV_cfH(S,U,B) +#define PZTRINGV_cfH(S,U,B) + +/* Need VOID_cfSTR because Absoft forced function types go through _cfSTR. */ +/* No spaces inside expansion. They screws up macro catenation kludge. */ +#define VOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICAL,A,B,C,D,E) +#define LONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define BYTEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define DOUBLEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define FLOATVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define INTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LOGICALVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define LONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SHORTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PBYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLOGICAL,A,B,C,D,E) +#define PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PSHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define STRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRING,A,B,C,D,E) +#define PSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRING,A,B,C,D,E) +#define STRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRINGV,A,B,C,D,E) +#define PSTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRINGV,A,B,C,D,E) +#define PNSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PNSTRING,A,B,C,D,E) +#define PPSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PPSTRING,A,B,C,D,E) +#define PVOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define ROUTINE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define SIMPLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define ZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,ZTRINGV,A,B,C,D,E) +#define PZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRINGV,A,B,C,D,E) +#define CF_0_cfSTR(N,T,A,B,C,D,E) + +/* See ACF table comments, which explain why CCF was split into two. */ +#define CCF(NAME,TN,I) _(TN,_cfSTR)(5,C,NAME,I,_(A,I),_(B,I),_(C,I)) +#define DEFAULT_cfC(M,I,A,B,C) +#define LOGICAL_cfC(M,I,A,B,C) A=C2FLOGICAL( A); +#define PLOGICAL_cfC(M,I,A,B,C) *A=C2FLOGICAL(*A); +#ifdef vmsFortran +#define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A, \ + C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.f.dsc$w_length=B.clen: \ + (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0')); + /* PSTRING_cfC to beware of array A which does not contain any \0. */ +#define PSTRING_cfC(M,I,A,B,C) (B.dsc$a_pointer=A, C==sizeof(char*) ? \ + B.dsc$w_length=strlen(A): (A[C-1]='\0',B.dsc$w_length=strlen(A), \ + memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), B.dsc$w_length=C-1)); +#else +#define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A), \ + C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.flen=B.clen: \ + (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0')); +#define PSTRING_cfC(M,I,A,B,C) (C==sizeof(char*)? B=strlen(A): \ + (A[C-1]='\0',B=strlen(A),memset((A)+B,' ',C-B-1),B=C-1)); +#endif + /* For CRAYFortran for (P)STRINGV_cfC, B.fs is set, but irrelevant. */ +#define STRINGV_cfC(M,I,A,B,C) \ + AATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF) +#define PSTRINGV_cfC(M,I,A,B,C) \ + APATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF) +#define ZTRINGV_cfC(M,I,A,B,C) \ + AATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 ) +#define PZTRINGV_cfC(M,I,A,B,C) \ + APATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 ) + +#define BYTE_cfCCC(A,B) &A +#define DOUBLE_cfCCC(A,B) &A +#if !defined(__CF__KnR) +#define FLOAT_cfCCC(A,B) &A + /* Although the VAX doesn't, at least the */ +#else /* HP and K&R mips promote float arg.'s of */ +#define FLOAT_cfCCC(A,B) &B /* unprototyped functions to double. Cannot */ +#endif /* use A here to pass the argument to FORTRAN. */ +#define INT_cfCCC(A,B) &A +#define LOGICAL_cfCCC(A,B) &A +#define LONG_cfCCC(A,B) &A +#define SHORT_cfCCC(A,B) &A +#define PBYTE_cfCCC(A,B) A +#define PDOUBLE_cfCCC(A,B) A +#define PFLOAT_cfCCC(A,B) A +#define PINT_cfCCC(A,B) A +#define PLOGICAL_cfCCC(A,B) B=A /* B used to keep a common W table. */ +#define PLONG_cfCCC(A,B) A +#define PSHORT_cfCCC(A,B) A + +#define CCCF(TN,I,M) _SEP_(TN,M,COMMA) _Icf(3,CC,TN,_(A,I),_(B,I)) +#define INT_cfCC(T,A,B) _(T,_cfCCC)(A,B) +#define INTV_cfCC(T,A,B) A +#define INTVV_cfCC(T,A,B) A +#define INTVVV_cfCC(T,A,B) A +#define INTVVVV_cfCC(T,A,B) A +#define INTVVVVV_cfCC(T,A,B) A +#define INTVVVVVV_cfCC(T,A,B) A +#define INTVVVVVVV_cfCC(T,A,B) A +#define PINT_cfCC(T,A,B) _(T,_cfCCC)(A,B) +#define PVOID_cfCC(T,A,B) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfCC(T,A,B) &A +#else +#define ROUTINE_cfCC(T,A,B) A +#endif +#define SIMPLE_cfCC(T,A,B) A +#ifdef vmsFortran +#define STRING_cfCC(T,A,B) &B.f +#define STRINGV_cfCC(T,A,B) &B +#define PSTRING_cfCC(T,A,B) &B +#define PSTRINGV_cfCC(T,A,B) &B +#else +#ifdef CRAYFortran +#define STRING_cfCC(T,A,B) _cptofcd(A,B.flen) +#define STRINGV_cfCC(T,A,B) _cptofcd(B.s,B.flen) +#define PSTRING_cfCC(T,A,B) _cptofcd(A,B) +#define PSTRINGV_cfCC(T,A,B) _cptofcd(A,B.flen) +#else +#define STRING_cfCC(T,A,B) A +#define STRINGV_cfCC(T,A,B) B.fs +#define PSTRING_cfCC(T,A,B) A +#define PSTRINGV_cfCC(T,A,B) B.fs +#endif +#endif +#define ZTRINGV_cfCC(T,A,B) STRINGV_cfCC(T,A,B) +#define PZTRINGV_cfCC(T,A,B) PSTRINGV_cfCC(T,A,B) + +#define BYTE_cfX return A0; +#define DOUBLE_cfX return A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfX return A0; +#else +#define FLOAT_cfX ASSIGNFLOAT(AA0,A0); return AA0; +#endif +#define INT_cfX return A0; +#define LOGICAL_cfX return F2CLOGICAL(A0); +#define LONG_cfX return A0; +#define SHORT_cfX return A0; +#define VOID_cfX return ; +#if defined(vmsFortran) || defined(CRAYFortran) +#define STRING_cfX return kill_trailing( \ + kill_trailing(AA0,CFORTRAN_NON_CHAR),' '); +#else +#define STRING_cfX return kill_trailing( \ + kill_trailing( A0,CFORTRAN_NON_CHAR),' '); +#endif + +#define CFFUN(NAME) _(__cf__,NAME) + +/* Note that we don't use LN here, but we keep it for consistency. */ +#define CCALLSFFUN0(UN,LN) CFFUN(UN)() + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define CCALLSFFUN1( UN,LN,T1, A1) \ + CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0) +#define CCALLSFFUN2( UN,LN,T1,T2, A1,A2) \ + CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0) +#define CCALLSFFUN3( UN,LN,T1,T2,T3, A1,A2,A3) \ + CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0) +#define CCALLSFFUN4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\ + CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0) +#define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0) +#define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0) +#define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0) +#define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0) +#define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\ + CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0) +#define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0) +#define CCALLSFFUN11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0) +#define CCALLSFFUN12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0) +#define CCALLSFFUN13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\ + CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0) + +#define CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\ +((CFFUN(UN)( BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \ + BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \ + BCF(TB,AB,1) BCF(TC,AC,1) BCF(TD,AD,1) BCF(TE,AE,1) \ + SCF(T1,LN,1,A1) SCF(T2,LN,2,A2) SCF(T3,LN,3,A3) SCF(T4,LN,4,A4) \ + SCF(T5,LN,5,A5) SCF(T6,LN,6,A6) SCF(T7,LN,7,A7) SCF(T8,LN,8,A8) \ + SCF(T9,LN,9,A9) SCF(TA,LN,A,AA) SCF(TB,LN,B,AB) SCF(TC,LN,C,AC) \ + SCF(TD,LN,D,AD)))) + +/* N.B. Create a separate function instead of using (call function, function +value here) because in order to create the variables needed for the input +arg.'s which may be const.'s one has to do the creation within {}, but these +can never be placed within ()'s. Therefore one must create wrapper functions. +gcc, on the other hand may be able to avoid the wrapper functions. */ + +/* Prototypes are needed to correctly handle the value returned correctly. N.B. +Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN +functions returning strings have extra arg.'s. Don't bother, since this only +causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn +for the same function in the same source code. Something done by the experts in +debugging only.*/ + +#define PROTOCCALLSFFUN0(F,UN,LN) \ +_(F,_cfPU)( CFC_(UN,LN))(CF_NULL_PROTO); \ +static _Icf(2,U,F,CFFUN(UN),0)() {_(F,_cfE) _Icf(3,GZ,F,UN,LN) ABSOFT_cf1(F));_(F,_cfX)} + +#define PROTOCCALLSFFUN1( T0,UN,LN,T1) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0) +#define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4) \ + PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0) +#define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0) +#define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0) +#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN11(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define PROTOCCALLSFFUN12(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define PROTOCCALLSFFUN13(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + +/* HP/UX 9.01 cc requires the blank between '_Icf(3,G,T0,UN,LN) CCCF(T1,1,0)' */ + +#ifndef __CF__KnR +#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \ + CFARGT14FS(UCF,HCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ +{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \ + CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \ + CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,A) \ + CCF(LN,TB,B) CCF(LN,TC,C) CCF(LN,TD,D) CCF(LN,TE,E) _Icf(3,G,T0,UN,LN) \ + CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) \ + WCF(TB,AB,B) WCF(TC,AC,C) WCF(TD,AD,D) WCF(TE,AE,E) _(T0,_cfX)} +#else +#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \ + CFARGT14FS(UUCF,HHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \ + CFARGT14FS(UUUCF,HHHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ; \ +{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \ + CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \ + CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,A) \ + CCF(LN,TB,B) CCF(LN,TC,C) CCF(LN,TD,D) CCF(LN,TE,E) _Icf(3,G,T0,UN,LN) \ + CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \ + WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \ + WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,A) \ + WCF(TB,AB,B) WCF(TC,AC,C) WCF(TD,AD,D) WCF(TE,AE,E) _(T0,_cfX)} +#endif + +/*-------------------------------------------------------------------------*/ + +/* UTILITIES FOR FORTRAN TO CALL C ROUTINES */ + +#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */ +#pragma nostandard +#endif + +#if defined(vmsFortran) || defined(CRAYFortran) +#define DCF(TN,I) +#define DDCF(TN,I) +#define DDDCF(TN,I) +#else +#define DCF(TN,I) HCF(TN,I) +#define DDCF(TN,I) HHCF(TN,I) +#define DDDCF(TN,I) HHHCF(TN,I) +#endif + +#define QCF(TN,I) _(TN,_cfSTR)(1,Q,_(B,I), 0,0,0,0) +#define DEFAULT_cfQ(B) +#define LOGICAL_cfQ(B) +#define PLOGICAL_cfQ(B) +#define STRINGV_cfQ(B) char *B; unsigned int _(B,N); +#define STRING_cfQ(B) char *B=NULL; +#define PSTRING_cfQ(B) char *B=NULL; +#define PSTRINGV_cfQ(B) STRINGV_cfQ(B) +#define PNSTRING_cfQ(B) char *B=NULL; +#define PPSTRING_cfQ(B) + +#ifdef __sgi /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */ +#define ROUTINE_orig *(void**)& +#else +#define ROUTINE_orig (void *) +#endif + +#define ROUTINE_1 ROUTINE_orig +#define ROUTINE_2 ROUTINE_orig +#define ROUTINE_3 ROUTINE_orig +#define ROUTINE_4 ROUTINE_orig +#define ROUTINE_5 ROUTINE_orig +#define ROUTINE_6 ROUTINE_orig +#define ROUTINE_7 ROUTINE_orig +#define ROUTINE_8 ROUTINE_orig +#define ROUTINE_9 ROUTINE_orig +#define ROUTINE_10 ROUTINE_orig +#define ROUTINE_11 ROUTINE_orig +#define ROUTINE_12 ROUTINE_orig +#define ROUTINE_13 ROUTINE_orig +#define ROUTINE_14 ROUTINE_orig + +#define TCF(NAME,TN,I,M) _SEP_(TN,M,COMMA) _(TN,_cfT)(NAME,I,_(A,I),_(B,I),_(C,I)) +#define BYTE_cfT(M,I,A,B,D) *A +#define DOUBLE_cfT(M,I,A,B,D) *A +#define FLOAT_cfT(M,I,A,B,D) *A +#define INT_cfT(M,I,A,B,D) *A +#define LOGICAL_cfT(M,I,A,B,D) F2CLOGICAL(*A) +#define LONG_cfT(M,I,A,B,D) *A +#define SHORT_cfT(M,I,A,B,D) *A +#define BYTEV_cfT(M,I,A,B,D) A +#define DOUBLEV_cfT(M,I,A,B,D) A +#define FLOATV_cfT(M,I,A,B,D) VOIDP A +#define INTV_cfT(M,I,A,B,D) A +#define LOGICALV_cfT(M,I,A,B,D) A +#define LONGV_cfT(M,I,A,B,D) A +#define SHORTV_cfT(M,I,A,B,D) A +#define BYTEVV_cfT(M,I,A,B,D) (void *)A /* We have to cast to void *,*/ +#define BYTEVVV_cfT(M,I,A,B,D) (void *)A /* since we don't know the */ +#define BYTEVVVV_cfT(M,I,A,B,D) (void *)A /* dimensions of the array. */ +#define BYTEVVVVV_cfT(M,I,A,B,D) (void *)A /* i.e. Unfortunately, can't */ +#define BYTEVVVVVV_cfT(M,I,A,B,D) (void *)A /* check that the type */ +#define BYTEVVVVVVV_cfT(M,I,A,B,D) (void *)A /* matches the prototype. */ +#define DOUBLEVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVVV_cfT(M,I,A,B,D) (void *)A +#define DOUBLEVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVVV_cfT(M,I,A,B,D) (void *)A +#define FLOATVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVV_cfT(M,I,A,B,D) (void *)A +#define INTVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVVV_cfT(M,I,A,B,D) (void *)A +#define INTVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LOGICALVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVVV_cfT(M,I,A,B,D) (void *)A +#define LONGVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVVV_cfT(M,I,A,B,D) (void *)A +#define SHORTVVVVVVV_cfT(M,I,A,B,D) (void *)A +#define PBYTE_cfT(M,I,A,B,D) A +#define PDOUBLE_cfT(M,I,A,B,D) A +#define PFLOAT_cfT(M,I,A,B,D) VOIDP A +#define PINT_cfT(M,I,A,B,D) A +#define PLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A) +#define PLONG_cfT(M,I,A,B,D) A +#define PSHORT_cfT(M,I,A,B,D) A +#define PVOID_cfT(M,I,A,B,D) A +#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) +#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) (*A) +#else +#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) A +#endif +/* A == pointer to the characters + D == length of the string, or of an element in an array of strings + E == number of elements in an array of strings */ +#define TTSTR( A,B,D) \ + ((B=(char*)malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' ')) +#define TTTTSTR( A,B,D) (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL: \ + memchr(A,'\0',D) ?A : TTSTR(A,B,D) +#define TTTTSTRV( A,B,D,E) (_(B,N)=E,B=(char*)malloc(_(B,N)*(D+1)), (void *) \ + vkill_trailing(f2cstrv(A,B,D+1, _(B,N)*(D+1)), D+1,_(B,N)*(D+1),' ')) +#ifdef vmsFortran +#define STRING_cfT(M,I,A,B,D) TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \ + A->dsc$w_length , A->dsc$l_m[0]) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define PPSTRING_cfT(M,I,A,B,D) A->dsc$a_pointer +#else +#ifdef CRAYFortran +#define STRING_cfT(M,I,A,B,D) TTTTSTR( _fcdtocp(A),B,_fcdlen(A)) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(_fcdtocp(A),B,_fcdlen(A), \ + num_elem(_fcdtocp(A),_fcdlen(A),_3(M,_STRV_A,I))) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( _fcdtocp(A),B,_fcdlen(A)) +#define PPSTRING_cfT(M,I,A,B,D) _fcdtocp(A) +#else +#define STRING_cfT(M,I,A,B,D) TTTTSTR( A,B,D) +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A,B,D, num_elem(A,D,_3(M,_STRV_A,I))) +#define PSTRING_cfT(M,I,A,B,D) TTSTR( A,B,D) +#define PPSTRING_cfT(M,I,A,B,D) A +#endif +#endif +#define PNSTRING_cfT(M,I,A,B,D) STRING_cfT(M,I,A,B,D) +#define PSTRINGV_cfT(M,I,A,B,D) STRINGV_cfT(M,I,A,B,D) +#define CF_0_cfT(M,I,A,B,D) + +#define RCF(TN,I) _(TN,_cfSTR)(3,R,_(A,I),_(B,I),_(C,I),0,0) +#define DEFAULT_cfR(A,B,D) +#define LOGICAL_cfR(A,B,D) +#define PLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A); +#define STRING_cfR(A,B,D) if (B) free(B); +#define STRINGV_cfR(A,B,D) free(B); +/* A and D as defined above for TSTRING(V) */ +#define RRRRPSTR( A,B,D) if (B) memcpy(A,B, _cfMIN(strlen(B),D)), \ + (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), free(B); +#define RRRRPSTRV(A,B,D) c2fstrv(B,A,D+1,(D+1)*_(B,N)), free(B); +#ifdef vmsFortran +#define PSTRING_cfR(A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length) +#else +#ifdef CRAYFortran +#define PSTRING_cfR(A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A)) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A)) +#else +#define PSTRING_cfR(A,B,D) RRRRPSTR( A,B,D) +#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A,B,D) +#endif +#endif +#define PNSTRING_cfR(A,B,D) PSTRING_cfR(A,B,D) +#define PPSTRING_cfR(A,B,D) + +#define BYTE_cfFZ(UN,LN) INTEGER_BYTE FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define DOUBLE_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define INT_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define LOGICAL_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define LONG_cfFZ(UN,LN) long FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define SHORT_cfFZ(UN,LN) short FCALLSC_QUALIFIER fcallsc(UN,LN)( +#define VOID_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)( +#ifndef __CF__KnR +/* The void is req'd by the Apollo, to make this an ANSI function declaration. + The Apollo promotes K&R float functions to double. */ +#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(void +#ifdef vmsFortran +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(fstring *AS +#else +#ifdef CRAYFortran +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(_fcd AS +#else +#if defined(AbsoftUNIXFortran) +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS +#else +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS, unsigned D0 +#endif +#endif +#endif +#else +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)( +#else +#define FLOAT_cfFZ(UN,LN) FLOATFUNCTIONTYPE FCALLSC_QUALIFIER fcallsc(UN,LN)( +#endif +#if defined(vmsFortran) || defined(CRAYFortran) || defined(AbsoftUNIXFortran) +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS +#else +#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS, D0 +#endif +#endif + +#define BYTE_cfF(UN,LN) BYTE_cfFZ(UN,LN) +#define DOUBLE_cfF(UN,LN) DOUBLE_cfFZ(UN,LN) +#ifndef __CF_KnR +#define FLOAT_cfF(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)( +#else +#define FLOAT_cfF(UN,LN) FLOAT_cfFZ(UN,LN) +#endif +#define INT_cfF(UN,LN) INT_cfFZ(UN,LN) +#define LOGICAL_cfF(UN,LN) LOGICAL_cfFZ(UN,LN) +#define LONG_cfF(UN,LN) LONG_cfFZ(UN,LN) +#define SHORT_cfF(UN,LN) SHORT_cfFZ(UN,LN) +#define VOID_cfF(UN,LN) VOID_cfFZ(UN,LN) +#define STRING_cfF(UN,LN) STRING_cfFZ(UN,LN), + +#define INT_cfFF +#define VOID_cfFF +#ifdef vmsFortran +#define STRING_cfFF fstring *AS; +#else +#ifdef CRAYFortran +#define STRING_cfFF _fcd AS; +#else +#define STRING_cfFF char *AS; unsigned D0; +#endif +#endif + +#define INT_cfL A0= +#define STRING_cfL A0= +#define VOID_cfL + +#define INT_cfK +#define VOID_cfK +/* KSTRING copies the string into the position provided by the caller. */ +#ifdef vmsFortran +#define STRING_cfK \ + memcpy(AS->dsc$a_pointer,A0,_cfMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))));\ + AS->dsc$w_length>(A0==NULL?0:strlen(A0))? \ + memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ', \ + AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0; +#else +#ifdef CRAYFortran +#define STRING_cfK \ + memcpy(_fcdtocp(AS),A0, _cfMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) ); \ + _fcdlen(AS)>(A0==NULL?0:strlen(A0))? \ + memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ', \ + _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0; +#else +#define STRING_cfK memcpy(AS,A0, _cfMIN(D0,(A0==NULL?0:strlen(A0))) ); \ + D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \ + ' ', D0-(A0==NULL?0:strlen(A0))):0; +#endif +#endif + +/* Note that K.. and I.. can't be combined since K.. has to access data before +R.., in order for functions returning strings which are also passed in as +arguments to work correctly. Note that R.. frees and hence may corrupt the +string. */ +#define BYTE_cfI return A0; +#define DOUBLE_cfI return A0; +#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT)) +#define FLOAT_cfI return A0; +#else +#define FLOAT_cfI RETURNFLOAT(A0); +#endif +#define INT_cfI return A0; +#ifdef hpuxFortran800 +/* Incredibly, functions must return true as 1, elsewhere .true.==0x01000000. */ +#define LOGICAL_cfI return ((A0)?1:0); +#else +#define LOGICAL_cfI return C2FLOGICAL(A0); +#endif +#define LONG_cfI return A0; +#define SHORT_cfI return A0; +#define STRING_cfI return ; +#define VOID_cfI return ; + +#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */ +#pragma standard +#endif + +#define FCALLSCSUB0( CN,UN,LN) FCALLSCFUN0(VOID,CN,UN,LN) +#define FCALLSCSUB1( CN,UN,LN,T1) FCALLSCFUN1(VOID,CN,UN,LN,T1) +#define FCALLSCSUB2( CN,UN,LN,T1,T2) FCALLSCFUN2(VOID,CN,UN,LN,T1,T2) +#define FCALLSCSUB3( CN,UN,LN,T1,T2,T3) FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3) +#define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) \ + FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4) +#define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \ + FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5) +#define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \ + FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6) +#define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) +#define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) +#define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) +#define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) +#define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) +#define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) +#define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) +#define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) + +#define FCALLSCFUN1( T0,CN,UN,LN,T1) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0) +#define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0) +#define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \ + FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0) +#define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0) +#define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0) +#define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ + FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0) +#define FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0) +#define FCALLSCFUN11(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0) +#define FCALLSCFUN12(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0) +#define FCALLSCFUN13(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \ + FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0) + +#ifndef __CF__KnR +#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf2(T0)) \ + {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)} + +#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) \ + { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,A,1) TCF(LN,TB,B,1) TCF(LN,TC,C,1) \ + TCF(LN,TD,D,1) TCF(LN,TE,E,1) ); _Icf(0,K,T0,0,0) \ + CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI) } +#else +#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf3(T0)) _Icf(0,FF,T0,0,0)\ + {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)} + +#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) _Icf(0,FF,T0,0,0) \ + CFARGT14FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE); \ + { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,A,1) TCF(LN,TB,B,1) TCF(LN,TC,C,1) \ + TCF(LN,TD,D,1) TCF(LN,TE,E,1) ); _Icf(0,K,T0,0,0) \ + CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI)} +#endif + + +#endif /* __CFORTRAN_LOADED */ diff --git a/src/include/compress.h b/src/include/compress.h new file mode 100644 index 0000000..7e3c406 --- /dev/null +++ b/src/include/compress.h @@ -0,0 +1,212 @@ +/* compress.h -- definitions for the decompression routines used in CFITSIO */ + +/* Blatantly copied and modified from the original gzip-1.2.4 source code. */ + +#include <stdlib.h> +#include <stdio.h> +#include <string.h> +#include <ctype.h> + +/* 'near' is only relevant for 16-bit PC with small memory model */ +# define near + +#if defined(VAXC) || defined(VMS) +# define RECORD_IO 1 +#else +# define RECORD_IO 0 +#endif + +#define get_char() get_byte() + +/* gzip.h -- common declarations for all gzip modules */ + +#define OF(args) args +typedef void *voidp; + +#define memzero(s, n) memset ((voidp)(s), 0, (n)) + +typedef unsigned char uch; +typedef unsigned short ush; +typedef unsigned long ulg; + +/* Return codes from gzip */ +#define OK 0 +#define ERROR 1 +#define WARNING 2 + +/* Compression methods (see algorithm.doc) */ +#define STORED 0 +#define COMPRESSED 1 +#define PACKED 2 +#define LZHED 3 +/* methods 4 to 7 reserved */ +#define DEFLATED 8 +#define MAX_METHODS 9 + +#define INBUFSIZ 0x8000 /* input buffer size */ +#define INBUF_EXTRA 64 /* required by unlzw() */ +#define OUTBUFSIZ 16384 /* output buffer size */ +#define OUTBUF_EXTRA 2048 /* required by unlzw() */ +#define DIST_BUFSIZE 0x8000 /* buffer for distances, see trees.c */ +#define WSIZE 0x8000 /* window size--must be a power of two, and */ + +#define DECLARE(type, array, size) type array[size] + +#define tab_suffix window +#define tab_prefix prev /* hash link (see deflate.c) */ +#define head (prev+WSIZE) /* hash head (see deflate.c) */ + +#define PACK_MAGIC "\037\036" /* Magic header for packed files */ +#define GZIP_MAGIC "\037\213" /* Magic header for gzip files, 1F 8B */ +#define OLD_GZIP_MAGIC "\037\236" /* Magic header for gzip 0.5 = freeze 1.x */ +#define LZH_MAGIC "\037\240" /* Magic header for SCO LZH Compress files*/ +#define LZW_MAGIC "\037\235" /* Magic header for lzw files, 1F 9D */ +#define PKZIP_MAGIC "\120\113\003\004" /* Magic header for pkzip files */ + +/* gzip flag byte */ +#define ASCII_FLAG 0x01 /* bit 0 set: file probably ascii text */ +#define CONTINUATION 0x02 /* bit 1 set: continuation of multi-part gzip file */ +#define EXTRA_FIELD 0x04 /* bit 2 set: extra field present */ +#define ORIG_NAME 0x08 /* bit 3 set: original file name present */ +#define COMMENT 0x10 /* bit 4 set: file comment present */ +#define ENCRYPTED 0x20 /* bit 5 set: file is encrypted */ +#define RESERVED 0xC0 /* bit 6,7: reserved */ + +#define MIN_MATCH 3 +#define MAX_MATCH 258 +#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) +#define MAX_DIST (WSIZE-MIN_LOOKAHEAD) +#define translate_eol 0 /* no option -a yet */ + +#define get_byte() (inptr < insize ? inbuf[inptr++] : fill_inbuf(0)) +#define try_byte() (inptr < insize ? inbuf[inptr++] : fill_inbuf(1)) +#define put_ubyte(c) {window[outcnt++]=(uch)(c); if (outcnt==WSIZE)\ + flush_window();} + +/* Macros for getting two-byte and four-byte header values */ +#define SH(p) ((ush)(uch)((p)[0]) | ((ush)(uch)((p)[1]) << 8)) +#define LG(p) ((ulg)(SH(p)) | ((ulg)(SH((p)+2)) << 16)) + +/* Diagnostic functions */ +# define Assert(cond,msg) +# define Trace(x) +# define Tracev(x) +# define Tracevv(x) +# define Tracec(c,x) +# define Tracecv(c,x) + +/* lzw.h -- define the lzw functions. */ + +#ifndef BITS +# define BITS 16 +#endif +#define INIT_BITS 9 /* Initial number of bits per code */ +#define BIT_MASK 0x1f /* Mask for 'number of compression bits' */ +#define BLOCK_MODE 0x80 +#define LZW_RESERVED 0x60 /* reserved bits */ +#define CLEAR 256 /* flush the dictionary */ +#define FIRST (CLEAR+1) /* first free entry */ + +/* prototypes */ + +#define local static +void ffpmsg(const char *err_message); + +local int get_method OF((FILE *in)); + +local ulg updcrc OF((uch *s, unsigned n)); +local int fill_inbuf OF((int eof_ok)); +local void flush_outbuf OF((void)); +local void flush_window OF((void)); +local void write_buf OF((voidp buf, unsigned cnt)); +local void error OF((char *m)); +local ulg flush_block OF((char *buf, ulg stored_len, int eof)); +typedef int file_t; /* Do not use stdio */ +#define NO_FILE (-1) /* in memory compression */ +local int file_read OF((char *buf, unsigned size)); +local void send_bits OF((int value, int length)); +local unsigned bi_reverse OF((unsigned value, int length)); +local void bi_windup OF((void)); +local void copy_block OF((char *buf, unsigned len, int header)); +local int (*read_buf) OF((char *buf, unsigned size)); +local void lm_init OF((int pack_level, ush *flags)); +local ulg deflate OF((void)); +local void ct_init OF((ush *attr, int *method)); +local int ct_tally OF((int dist, int lc)); +local void bi_init OF((file_t zipfile)); + +#define put_byte(c) {outbuf[outcnt++]=(uch)(c); if (outcnt==OUTBUFSIZ)\ + flush_outbuf();} + +/* Output a 16 bit value, lsb first */ +#define put_short(w) \ +{ if (outcnt < OUTBUFSIZ-2) { \ + outbuf[outcnt++] = (uch) ((w) & 0xff); \ + outbuf[outcnt++] = (uch) ((ush)(w) >> 8); \ + } else { \ + put_byte((uch)((w) & 0xff)); \ + put_byte((uch)((ush)(w) >> 8)); \ + } \ +} + +/* Output a 32 bit value to the bit stream, lsb first */ +#define put_long(n) { \ + put_short((n) & 0xffff); \ + put_short(((ulg)(n)) >> 16); \ +} + +#define seekable() 0 /* force sequential output */ + +/* io.c */ +local void fillbuf OF((int n)); +local unsigned getbits OF((int n)); +local void init_getbits OF((void)); + +/* maketbl.c */ +local void make_table OF((int nchar, uch bitlen[], + int tablebits, ush table[])); + +/* huf.c */ +local void read_pt_len OF((int nn, int nbit, int i_special)); +local void read_c_len OF((void)); +local unsigned decode_c OF((void)); +local unsigned decode_p OF((void)); +local void huf_decode_start OF((void)); + +/* decode.c */ +local void decode_start OF((void)); +local unsigned decode OF((unsigned count, uch buffer[])); + +local int unlzh OF((FILE *in, FILE *out)); +local int unlzw OF((FILE *in, FILE *out)); + +local void read_tree OF((void)); +local void build_tree_unpack OF((void)); + +local int unpack OF((FILE *in, FILE *out)); +local int check_zipfile OF((FILE *in)); +local int unzip OF((FILE *in, FILE *out)); + +int (*work) OF((FILE *infile, FILE *outfile)) = unzip; /* function to call */ + +/* inflate.c */ +struct huft { + uch e; /* number of extra bits or operation */ + uch b; /* number of bits in this code or subcode */ + union { + ush n; /* literal, length base, or distance base */ + struct huft *t; /* pointer to next level of table */ + } v; +}; + +local int huft_build OF((unsigned *, unsigned, unsigned, ush *, ush *, + struct huft **, int *)); +local int huft_free OF((struct huft *)); +local int inflate_codes OF((struct huft *, struct huft *, int, int)); +local int inflate_stored OF((void)); +local int inflate_fixed OF((void)); +local int inflate_dynamic OF((void)); +local int inflate_block OF((int *)); +local int inflate OF((void)); + +/* end of compress.h include file */ diff --git a/src/include/config.h.in b/src/include/config.h.in new file mode 100644 index 0000000..587246e --- /dev/null +++ b/src/include/config.h.in @@ -0,0 +1,142 @@ +/* src/include/config.h.in. Generated from configure.ac by autoheader. */ + +/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP + systems. This function is required for `alloca.c' support on those systems. + */ +#undef CRAY_STACKSEG_END + +/* Define to 1 if using `alloca.c'. */ +#undef C_ALLOCA + +/* Define to 1 if you have `alloca', as a function or macro. */ +#undef HAVE_ALLOCA + +/* Define to 1 if you have <alloca.h> and it should be used (not on Ultrix). + */ +#undef HAVE_ALLOCA_H + +/* Define to 1 if you have the <dlfcn.h> header file. */ +#undef HAVE_DLFCN_H + +/* Define to 1 if you have the <fcntl.h> header file. */ +#undef HAVE_FCNTL_H + +/* Define to 1 if you have the `floor' function. */ +#undef HAVE_FLOOR + +/* Define to 1 if you have the <inttypes.h> header file. */ +#undef HAVE_INTTYPES_H + +/* Define to 1 if you have the <limits.h> header file. */ +#undef HAVE_LIMITS_H + +/* Define to 1 if your system has a GNU libc compatible `malloc' function, and + to 0 otherwise. */ +#undef HAVE_MALLOC + +/* Define to 1 if you have the <malloc.h> header file. */ +#undef HAVE_MALLOC_H + +/* Define to 1 if you have the `memchr' function. */ +#undef HAVE_MEMCHR + +/* Define to 1 if you have the <memory.h> header file. */ +#undef HAVE_MEMORY_H + +/* Define to 1 if you have the `memset' function. */ +#undef HAVE_MEMSET + +/* Define to 1 if you have the `modf' function. */ +#undef HAVE_MODF + +/* Define to 1 if you have the `pow' function. */ +#undef HAVE_POW + +/* Define to 1 if you have the `sqrt' function. */ +#undef HAVE_SQRT + +/* Define to 1 if you have the <stddef.h> header file. */ +#undef HAVE_STDDEF_H + +/* Define to 1 if you have the <stdint.h> header file. */ +#undef HAVE_STDINT_H + +/* Define to 1 if you have the <stdlib.h> header file. */ +#undef HAVE_STDLIB_H + +/* Define to 1 if you have the `strcasecmp' function. */ +#undef HAVE_STRCASECMP + +/* Define to 1 if you have the `strerror' function. */ +#undef HAVE_STRERROR + +/* Define to 1 if you have the <strings.h> header file. */ +#undef HAVE_STRINGS_H + +/* Define to 1 if you have the <string.h> header file. */ +#undef HAVE_STRING_H + +/* Define to 1 if you have the `strncasecmp' function. */ +#undef HAVE_STRNCASECMP + +/* Define to 1 if you have the `strrchr' function. */ +#undef HAVE_STRRCHR + +/* Define to 1 if you have the `strtol' function. */ +#undef HAVE_STRTOL + +/* Define to 1 if you have the <sys/stat.h> header file. */ +#undef HAVE_SYS_STAT_H + +/* Define to 1 if you have the <sys/types.h> header file. */ +#undef HAVE_SYS_TYPES_H + +/* Define to 1 if you have the <unistd.h> header file. */ +#undef HAVE_UNISTD_H + +/* Define to 1 if the system has the type `_Bool'. */ +#undef HAVE__BOOL + +/* Define to the sub-directory where libtool stores uninstalled libraries. */ +#undef LT_OBJDIR + +/* Name of package */ +#undef PACKAGE + +/* Define to the address where bug reports for this package should be sent. */ +#undef PACKAGE_BUGREPORT + +/* Define to the full name of this package. */ +#undef PACKAGE_NAME + +/* Define to the full name and version of this package. */ +#undef PACKAGE_STRING + +/* Define to the one symbol short name of this package. */ +#undef PACKAGE_TARNAME + +/* Define to the home page for this package. */ +#undef PACKAGE_URL + +/* Define to the version of this package. */ +#undef PACKAGE_VERSION + +/* If using the C implementation of alloca, define if you know the + direction of stack growth for your system; otherwise it will be + automatically deduced at runtime. + STACK_DIRECTION > 0 => grows toward higher addresses + STACK_DIRECTION < 0 => grows toward lower addresses + STACK_DIRECTION = 0 => direction of growth unknown */ +#undef STACK_DIRECTION + +/* Define to 1 if you have the ANSI C header files. */ +#undef STDC_HEADERS + +/* Version number of package */ +#undef VERSION + +/* Define to rpl_malloc if the replacement function should be used. */ +#undef malloc + +/* Define to `unsigned int' if <sys/types.h> does not define. */ +#undef size_t diff --git a/src/include/drvrsmem.h b/src/include/drvrsmem.h new file mode 100644 index 0000000..cd63810 --- /dev/null +++ b/src/include/drvrsmem.h @@ -0,0 +1,178 @@ +/* S H A R E D M E M O R Y D R I V E R + ======================================= + + by Jerzy.Borkowski@obs.unige.ch + +09-Mar-98 : initial version 1.0 released +23-Mar-98 : shared_malloc now accepts new handle as an argument +*/ + + +#include <sys/ipc.h> /* this is necessary for Solaris/Linux */ +#include <sys/shm.h> +#include <sys/sem.h> + +#ifdef _AIX +#include <fcntl.h> +#else +#include <sys/fcntl.h> +#endif + + /* configuration parameters */ + +#define SHARED_MAXSEG (16) /* maximum number of shared memory blocks */ + +#define SHARED_KEYBASE (14011963) /* base for shared memory keys, may be overriden by getenv */ +#define SHARED_FDNAME ("/tmp/.shmem-lockfile") /* template for lock file name */ + +#define SHARED_ENV_KEYBASE ("SHMEM_LIB_KEYBASE") /* name of environment variable */ +#define SHARED_ENV_MAXSEG ("SHMEM_LIB_MAXSEG") /* name of environment variable */ + + /* useful constants */ + +#define SHARED_RDONLY (0) /* flag for shared_(un)lock, lock for read */ +#define SHARED_RDWRITE (1) /* flag for shared_(un)lock, lock for write */ +#define SHARED_WAIT (0) /* flag for shared_lock, block if cannot lock immediate */ +#define SHARED_NOWAIT (2) /* flag for shared_lock, fail if cannot lock immediate */ +#define SHARED_NOLOCK (0x100) /* flag for shared_validate function */ + +#define SHARED_RESIZE (4) /* flag for shared_malloc, object is resizeable */ +#define SHARED_PERSIST (8) /* flag for shared_malloc, object is not deleted after last proc detaches */ + +#define SHARED_INVALID (-1) /* invalid handle for semaphore/shared memory */ + +#define SHARED_EMPTY (0) /* entries for shared_used table */ +#define SHARED_USED (1) + +#define SHARED_GRANUL (16384) /* granularity of shared_malloc allocation = phys page size, system dependent */ + + + + /* checkpoints in shared memory segments - might be omitted */ + +#define SHARED_ID_0 ('J') /* first byte of identifier in BLKHEAD */ +#define SHARED_ID_1 ('B') /* second byte of identifier in BLKHEAD */ + +#define BLOCK_REG (0) /* value for tflag member of BLKHEAD */ +#define BLOCK_SHARED (1) /* value for tflag member of BLKHEAD */ + + /* generic error codes */ + +#define SHARED_OK (0) + +#define SHARED_ERR_MIN_IDX SHARED_BADARG +#define SHARED_ERR_MAX_IDX SHARED_NORESIZE + + +#define DAL_SHM_FREE (0) +#define DAL_SHM_USED (1) + +#define DAL_SHM_ID0 ('D') +#define DAL_SHM_ID1 ('S') +#define DAL_SHM_ID2 ('M') + +#define DAL_SHM_SEGHEAD_ID (0x19630114) + + + + /* data types */ + +/* BLKHEAD object is placed at the beginning of every memory segment (both + shared and regular) to allow automatic recognition of segments type */ + +typedef union + { struct BLKHEADstruct + { char ID[2]; /* ID = 'JB', just as a checkpoint */ + char tflag; /* is it shared memory or regular one ? */ + int handle; /* this is not necessary, used only for non-resizeable objects via ptr */ + } s; + double d; /* for proper alignment on every machine */ + } BLKHEAD; + +typedef void *SHARED_P; /* generic type of shared memory pointer */ + +typedef struct SHARED_GTABstruct /* data type used in global table */ + { int sem; /* access semaphore (1 field): process count */ + int semkey; /* key value used to generate semaphore handle */ + int key; /* key value used to generate shared memory handle (realloc changes it) */ + int handle; /* handle of shared memory segment */ + int size; /* size of shared memory segment */ + int nprocdebug; /* attached proc counter, helps remove zombie segments */ + char attr; /* attributes of shared memory object */ + } SHARED_GTAB; + +typedef struct SHARED_LTABstruct /* data type used in local table */ + { BLKHEAD *p; /* pointer to segment (may be null) */ + int tcnt; /* number of threads in this process attached to segment */ + int lkcnt; /* >=0 <- number of read locks, -1 - write lock */ + long seekpos; /* current pointer position, read/write/seek operations change it */ + } SHARED_LTAB; + + + /* system dependent definitions */ + +#ifndef HAVE_FLOCK_T +typedef struct flock flock_t; +#define HAVE_FLOCK_T +#endif + +#ifndef HAVE_UNION_SEMUN +union semun + { int val; + struct semid_ds *buf; + unsigned short *array; + }; +#define HAVE_UNION_SEMUN +#endif + + +typedef struct DAL_SHM_SEGHEAD_STRUCT DAL_SHM_SEGHEAD; + +struct DAL_SHM_SEGHEAD_STRUCT + { int ID; /* ID for debugging */ + int h; /* handle of sh. mem */ + int size; /* size of data area */ + int nodeidx; /* offset of root object (node struct typically) */ + }; + + /* API routines */ + +#ifdef __cplusplus +extern "C" { +#endif + +void shared_cleanup(void); /* must be called at exit/abort */ +int shared_init(int debug_msgs); /* must be called before any other shared memory routine */ +int shared_recover(int id); /* try to recover dormant segment(s) after applic crash */ +int shared_malloc(long size, int mode, int newhandle); /* allocate n-bytes of shared memory */ +int shared_attach(int idx); /* attach to segment given index to table */ +int shared_free(int idx); /* release shared memory */ +SHARED_P shared_lock(int idx, int mode); /* lock segment for reading */ +SHARED_P shared_realloc(int idx, long newsize); /* reallocate n-bytes of shared memory (ON LOCKED SEGMENT ONLY) */ +int shared_size(int idx); /* get size of attached shared memory segment (ON LOCKED SEGMENT ONLY) */ +int shared_attr(int idx); /* get attributes of attached shared memory segment (ON LOCKED SEGMENT ONLY) */ +int shared_set_attr(int idx, int newattr); /* set attributes of attached shared memory segment (ON LOCKED SEGMENT ONLY) */ +int shared_unlock(int idx); /* unlock segment (ON LOCKED SEGMENT ONLY) */ +int shared_set_debug(int debug_msgs); /* set/reset debug mode */ +int shared_set_createmode(int mode); /* set/reset debug mode */ +int shared_list(int id); /* list segment(s) */ +int shared_uncond_delete(int id); /* uncondintionally delete (NOWAIT operation) segment(s) */ + +int smem_init(void); +int smem_shutdown(void); +int smem_setoptions(int options); +int smem_getoptions(int *options); +int smem_getversion(int *version); +int smem_open(char *filename, int rwmode, int *driverhandle); +int smem_create(char *filename, int *driverhandle); +int smem_close(int driverhandle); +int smem_remove(char *filename); +int smem_size(int driverhandle, long *size); +int smem_flush(int driverhandle); +int smem_seek(int driverhandle, long offset); +int smem_read(int driverhandle, void *buffer, long nbytes); +int smem_write(int driverhandle, void *buffer, long nbytes); + +#ifdef __cplusplus +} +#endif diff --git a/src/include/eval_defs.h b/src/include/eval_defs.h new file mode 100644 index 0000000..c650311 --- /dev/null +++ b/src/include/eval_defs.h @@ -0,0 +1,147 @@ +#include <stdio.h> +#include <math.h> +#include <stdlib.h> +#include <string.h> +#if defined(__sgi) || defined(__hpux) +#include <alloca.h> +#endif +#ifdef sparc +#include <malloc.h> +#endif +#include "fitsio2.h" + +#ifndef FFBISON +#include "eval_tab.h" +#endif + +#define MAXDIMS 5 +#define MAXSUBS 10 +#define MAXVARNAME 80 +#define CONST_OP -1000 +#define pERROR -1 + +typedef struct { + char name[MAXVARNAME+1]; + int type; + long nelem; + int naxis; + long naxes[MAXDIMS]; + char *undef; + void *data; + } DataInfo; + +typedef struct { + long nelem; + int naxis; + long naxes[MAXDIMS]; + char *undef; + union { + double dbl; + long lng; + char log; + char str[256]; + double *dblptr; + long *lngptr; + char *logptr; + char **strptr; + void *ptr; + } data; + } lval; + +typedef struct Node { + int operation; + void (*DoOp)(struct Node *this); + int nSubNodes; + int SubNodes[MAXSUBS]; + int type; + lval value; + } Node; + +typedef struct { + fitsfile *def_fptr; + int (*getData)( char *dataName, void *dataValue ); + int (*loadData)( int varNum, long fRow, long nRows, + void *data, char *undef ); + + int compressed; + int timeCol; + int parCol; + int valCol; + + char *expr; + int index; + int is_eobuf; + + Node *Nodes; + int nNodes; + int nNodesAlloc; + int resultNode; + + long firstRow; + long nRows; + + int nCols; + iteratorCol *colData; + DataInfo *varData; + + long firstDataRow; + long nDataRows; + long totalRows; + + int datatype; + + int status; + } ParseData; + +typedef enum { + rnd_fct = 1001, + sum_fct, + nelem_fct, + sin_fct, + cos_fct, + tan_fct, + asin_fct, + acos_fct, + atan_fct, + sinh_fct, + cosh_fct, + tanh_fct, + exp_fct, + log_fct, + log10_fct, + sqrt_fct, + abs_fct, + atan2_fct, + ceil_fct, + floor_fct, + round_fct, + min1_fct, + min2_fct, + max1_fct, + max2_fct, + near_fct, + circle_fct, + box_fct, + elps_fct, + isnull_fct, + defnull_fct, + gtifilt_fct, + regfilt_fct, + row_fct + } funcOp; + +extern ParseData gParse; + +#ifdef __cplusplus +extern "C" { +#endif + + int ffparse(void); + int fflex(void); + void ffrestart(FILE*); + + void Evaluate_Parser( long firstRow, long nRows ); + +#ifdef __cplusplus + } +#endif diff --git a/src/include/eval_tab.h b/src/include/eval_tab.h new file mode 100644 index 0000000..784ac91 --- /dev/null +++ b/src/include/eval_tab.h @@ -0,0 +1,37 @@ +typedef union { + int Node; /* Index of Node */ + double dbl; /* real value */ + long lng; /* integer value */ + char log; /* logical value */ + char str[256]; /* string value */ +} FFSTYPE; +#define BOOLEAN 258 +#define LONG 259 +#define DOUBLE 260 +#define STRING 261 +#define BITSTR 262 +#define FUNCTION 263 +#define BFUNCTION 264 +#define GTIFILTER 265 +#define REGFILTER 266 +#define COLUMN 267 +#define BCOLUMN 268 +#define SCOLUMN 269 +#define BITCOL 270 +#define ROWREF 271 +#define OR 272 +#define AND 273 +#define EQ 274 +#define NE 275 +#define GT 276 +#define LT 277 +#define LTE 278 +#define GTE 279 +#define POWER 280 +#define NOT 281 +#define INTCAST 282 +#define FLTCAST 283 +#define UMINUS 284 + + +extern FFSTYPE fflval; diff --git a/src/include/f77_wrap.h b/src/include/f77_wrap.h new file mode 100644 index 0000000..121850f --- /dev/null +++ b/src/include/f77_wrap.h @@ -0,0 +1,277 @@ +#define UNSIGNED_BYTE +#include "cfortran.h" + +/************************************************************************ + DEC C creates longs as 8-byte integers. On most other machines, ints + and longs are both 4-bytes, so both are compatible with Fortrans + default integer which is 4-bytes. To support DECs, we must redefine + LONGs and convert them to 8-bytes when going to C, and restore them + to 4-bytes when returning to Fortran. Ugh!!! +*************************************************************************/ + +#if (defined DECFortran) || (defined(__alpha) && defined(g77Fortran)) + +#undef LONGV_cfSTR +#undef PLONG_cfSTR +#undef LONGVVVVVVV_cfTYPE +#undef PLONG_cfTYPE +#undef LONGV_cfT +#undef PLONG_cfT + +#define LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LONGV,A,B,C,D,E) +#define PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLONG,A,B,C,D,E) +#define LONGVVVVVVV_cfTYPE int +#define PLONG_cfTYPE int +#define LONGV_cfQ(B) long *B, _(B,N); +#define PLONG_cfQ(B) long B; +#define LONGV_cfT(M,I,A,B,D) ( (_(B,N) = * _3(M,_LONGV_A,I)), \ + B = F2Clongv(_(B,N),A) ) +#define PLONG_cfT(M,I,A,B,D) ((B=*A),&B) +#define LONGV_cfR(A,B,D) C2Flongv(_(B,N),A,B); +#define PLONG_cfR(A,B,D) *A=B; +#define LONGV_cfH(S,U,B) +#define PLONG_cfH(S,U,B) + +static long *F2Clongv(long size, int *A) +{ + long i; + long *B; + + B=(long *)malloc( size*sizeof(long) ); + for(i=0;i<size;i++) B[i]=A[i]; + return(B); +} + +static void C2Flongv(long size, int *A, long *B) +{ + long i; + + for(i=0;i<size;i++) A[i]=B[i]; + free(B); +} + +#endif + +/************************************************************************ + Modify cfortran.h's handling of strings. C interprets a "char **" + parameter as an array of pointers to the strings (or as a handle), + not as a pointer to a block of contiguous strings. Also set a + a minimum length for string allocations, to minimize risk of + overflow. +*************************************************************************/ + +extern unsigned long gMinStrLen; + +#undef STRINGV_cfQ +#undef STRINGV_cfR +#undef TTSTR +#undef TTTTSTRV +#undef RRRRPSTRV + +#undef PPSTRING_cfT + +#ifdef vmsFortran +#define PPSTRING_cfT(M,I,A,B,D) (unsigned char*)A->dsc$a_pointer + +/* We want single strings to be equivalent to string vectors with */ +/* a single element, so ignore the number of elements info in the */ +/* vector structure, and rely on the NUM_ELEM definitions. */ + +#undef STRINGV_cfT +#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \ + A->dsc$w_length, \ + num_elem(A->dsc$a_pointer, \ + A->dsc$w_length, \ + _3(M,_STRV_A,I) ) ) +#else +#ifdef CRAYFortran +#define PPSTRING_cfT(M,I,A,B,D) (unsigned char*)_fcdtocp(A) +#else +#define PPSTRING_cfT(M,I,A,B,D) (unsigned char*)A +#endif +#endif + +#define _cfMAX(A,B) ( (A>B) ? A : B ) +#define STRINGV_cfQ(B) char **B; unsigned int _(B,N), _(B,M); +#define STRINGV_cfR(A,B,D) free(B[0]); free(B); +#define TTSTR( A,B,D) \ + ((B=(char*)malloc(_cfMAX(D,gMinStrLen)+1))[D]='\0',memcpy(B,A,D), \ + kill_trailing(B,' ')) +#define TTTTSTRV( A,B,D,E) ( \ + _(B,N)=_cfMAX(E,1), \ + _(B,M)=_cfMAX(D,gMinStrLen)+1, \ + B=(char**)malloc(_(B,N)*sizeof(char*)), \ + B[0]=(char*)malloc(_(B,N)*_(B,M)), \ + vindex(B,_(B,M),_(B,N),f2cstrv2(A,B[0],D,_(B,M),_(B,N))) \ + ) +#define RRRRPSTRV(A,B,D) \ + c2fstrv2(B[0],A,_(B,M),D,_(B,N)), \ + free(B[0]), \ + free(B); + +static char **vindex(char **B, int elem_len, int nelem, char *B0) +{ + int i; + if( nelem ) + for( i=0;i<nelem;i++ ) B[i] = B0+i*elem_len; + return B; +} + +static char *c2fstrv2(char* cstr, char *fstr, int celem_len, int felem_len, + int nelem) +{ + int i,j; + + if( nelem ) + for (i=0; i<nelem; i++) { + for (j=0; j<felem_len && *cstr; j++) *fstr++ = *cstr++; + cstr += celem_len-j; + for (; j<felem_len; j++) *fstr++ = ' '; + } + return( fstr-felem_len*nelem ); +} + +static char *f2cstrv2(char *fstr, char* cstr, int felem_len, int celem_len, + int nelem) +{ + int i,j; + + if( nelem ) + for (i=0; i<nelem; i++, cstr+=(celem_len-felem_len)) { + for (j=0; j<felem_len; j++) *cstr++ = *fstr++; + *cstr='\0'; + kill_trailingn( cstr-felem_len, ' ', cstr ); + } + return( cstr-celem_len*nelem ); +} + +/************************************************************************ + The following definitions redefine the BYTE data type to be + interpretted as a character*1 string instead of an integer*1 which + is not supported by all compilers. +*************************************************************************/ + +#undef BYTE_cfT +#undef BYTEV_cfT +#undef BYTE_cfINT +#undef BYTEV_cfINT +#undef BYTE_cfSTR +#undef BYTEV_cfSTR + +#define BYTE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,BYTE,B,X,Y,Z,0) +#define BYTEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,BYTEV,B,X,Y,Z,0) +#define BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,BYTE,A,B,C,D,E) +#define BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,BYTEV,A,B,C,D,E) +#define BYTE_cfSEP(T,B) INT_cfSEP(T,B) +#define BYTEV_cfSEP(T,B) INT_cfSEP(T,B) +#define BYTE_cfH(S,U,B) STRING_cfH(S,U,B) +#define BYTEV_cfH(S,U,B) STRING_cfH(S,U,B) +#define BYTE_cfQ(B) +#define BYTEV_cfQ(B) +#define BYTE_cfR(A,B,D) +#define BYTEV_cfR(A,B,D) + +#ifdef vmsFortran +#define BYTE_cfN(T,A) fstring * A +#define BYTEV_cfN(T,A) fstringvector * A +#define BYTE_cfT(M,I,A,B,D) (INTEGER_BYTE)((A->dsc$a_pointer)[0]) +#define BYTEV_cfT(M,I,A,B,D) (INTEGER_BYTE*)A->dsc$a_pointer +#else +#ifdef CRAYFortran +#define BYTE_cfN(T,A) _fcd A +#define BYTEV_cfN(T,A) _fcd A +#define BYTE_cfT(M,I,A,B,D) (INTEGER_BYTE)((_fcdtocp(A))[0]) +#define BYTEV_cfT(M,I,A,B,D) (INTEGER_BYTE*)_fcdtocp(A) +#else +#define BYTE_cfN(T,A) INTEGER_BYTE * A +#define BYTEV_cfN(T,A) INTEGER_BYTE * A +#define BYTE_cfT(M,I,A,B,D) A[0] +#define BYTEV_cfT(M,I,A,B,D) A +#endif +#endif + +/************************************************************************ + The following definitions and functions handle conversions between + C and Fortran arrays of LOGICALS. Individually, LOGICALS are + treated as int's but as char's when in an array. cfortran defines + (F2C/C2F)LOGICALV but never uses them, so these routines also + handle TRUE/FALSE conversions. +*************************************************************************/ + +#undef LOGICALV_cfSTR +#undef LOGICALV_cfT +#define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICALV,A,B,C,D,E) +#define LOGICALV_cfQ(B) char *B; unsigned int _(B,N); +#define LOGICALV_cfT(M,I,A,B,D) (_(B,N)= * _3(M,_LOGV_A,I), \ + B=F2CcopyLogVect(_(B,N),A)) +#define LOGICALV_cfR(A,B,D) C2FcopyLogVect(_(B,N),A,B); +#define LOGICALV_cfH(S,U,B) + +static char *F2CcopyLogVect(long size, int *A) +{ + long i; + char *B; + + B=(char *)malloc(size*sizeof(char)); + for( i=0; i<size; i++ ) B[i]=F2CLOGICAL(A[i]); + return(B); +} + +static void C2FcopyLogVect(long size, int *A, char *B) +{ + long i; + + for( i=0; i<size; i++ ) A[i]=C2FLOGICAL(B[i]); + free(B); +} + +/*------------------ Fortran File Handling ----------------------*/ +/* Fortran uses unit numbers, whereas C uses file pointers, so */ +/* a global array of file pointers is setup in which Fortran's */ +/* unit number serves as the index. Two FITSIO routines are */ +/* the integer unit number and the fitsfile file pointer. */ +/*-----------------------------------------------------------------*/ + +#define MAXFITSFILES 200 /* Array of file pointers indexed */ +extern fitsfile *gFitsFiles[]; /* by Fortran unit numbers */ + +#define FITSUNIT_cfINT(N,A,B,X,Y,Z) INT_cfINT(N,A,B,X,Y,Z) +#define FITSUNIT_cfSTR(N,T,A,B,C,D,E) INT_cfSTR(N,T,A,B,C,D,E) +#define FITSUNIT_cfT(M,I,A,B,D) gFitsFiles[*A] +#define FITSUNITVVVVVVV_cfTYPE int +#define PFITSUNIT_cfINT(N,A,B,X,Y,Z) PINT_cfINT(N,A,B,X,Y,Z) +#define PFITSUNIT_cfSTR(N,T,A,B,C,D,E) PINT_cfSTR(N,T,A,B,C,D,E) +#define PFITSUNIT_cfT(M,I,A,B,D) (gFitsFiles + *A) +#define PFITSUNIT_cfTYPE int + + +/*---------------------- Make C++ Happy -----------------------------*/ +/* Redefine FCALLSCFUNn so that they create prototypes of themselves */ +/* and change TTTTSTR to use (char *)0 instead of NULL */ +/*-------------------------------------------------------------------*/ + +#undef FCALLSCFUN0 +#undef FCALLSCFUN14 +#undef TTTTSTR + +#define TTTTSTR(A,B,D) ( !(D<4||A[0]||A[1]||A[2]||A[3]) ) ? ((char*)0) : \ + memchr(A,'\0',D) ? A : TTSTR(A,B,D) + +#define FCALLSCFUN0(T0,CN,UN,LN) \ + CFextern _(T0,_cfFZ)(UN,LN) void ABSOFT_cf2(T0)); \ + CFextern _(T0,_cfFZ)(UN,LN) void ABSOFT_cf2(T0)) \ + {_Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN(); _Icf(0,K,T0,0,0) _(T0,_cfI)} + +#define FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \ + CFextern _(T0,_cfF)(UN,LN) \ + CFARGT14(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) \ + { CFARGT14S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \ + _Icf(2,UU,T0,A0,0); _Icf(0,L,T0,0,0) CN( TCF(LN,T1,1,0) TCF(LN,T2,2,1) \ + TCF(LN,T3,3,1) TCF(LN,T4,4,1) TCF(LN,T5,5,1) TCF(LN,T6,6,1) TCF(LN,T7,7,1) \ + TCF(LN,T8,8,1) TCF(LN,T9,9,1) TCF(LN,TA,A,1) TCF(LN,TB,B,1) TCF(LN,TC,C,1) \ + TCF(LN,TD,D,1) TCF(LN,TE,E,1) ); _Icf(0,K,T0,0,0) \ + CFARGT14S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfI) \ + } + diff --git a/src/include/fusebuf.h b/src/include/fusebuf.h new file mode 100644 index 0000000..954a979 --- /dev/null +++ b/src/include/fusebuf.h @@ -0,0 +1,34 @@ +/******************************************************************************* + * Johns Hopkins University + * Center For Astrophysical Sciences + * FUSE + ******************************************************************************* + * + * Synopsis: #include "fusebuf.h" + * + * Description: Structure definitions and routine prototyping for multi-line + * file buffering as handled by fusebuf.c. + * + * History: 08/17/98 gak Begin work + * 08/18/98 gak Tested and working + * (as called by cf_make_ff) + * + ******************************************************************************/ + +typedef struct { + fitsfile *fits; /* Pointer to open FITS structure. */ + int hdu; /* HDU containing image to buffer. */ + int nx, ny; /* X and Y dimensions of the image. */ + float **buf, /* Array of pointers to buffered lines. */ + **y; /* Pointers to buffered lines in y order. */ + int nl, /* Number of lines buffered. */ + yfirst, ylast, /* Row numbers of buffered lines */ + znext; /* Ordinal of next line ptr to use. */ +} imgbuf; + +int cf_openextn(fitsfile *, int, imgbuf *, int, int *); + +int cf_closeextn(imgbuf *, int *); + +float getpixf(imgbuf *, int, int); + diff --git a/src/include/group.h b/src/include/group.h new file mode 100644 index 0000000..f7aae5b --- /dev/null +++ b/src/include/group.h @@ -0,0 +1,65 @@ +#define MAX_HDU_TRACKER 1000 + +typedef struct _HDUtracker HDUtracker; + +struct _HDUtracker +{ + int nHDU; + + char *filename[MAX_HDU_TRACKER]; + int position[MAX_HDU_TRACKER]; + + char *newFilename[MAX_HDU_TRACKER]; + int newPosition[MAX_HDU_TRACKER]; +}; + +/* functions used internally in the grouping convention module */ + +int ffgtdc(int grouptype, int xtensioncol, int extnamecol, int extvercol, + int positioncol, int locationcol, int uricol, char *ttype[], + char *tform[], int *ncols, int *status); + +int ffgtgc(fitsfile *gfptr, int *xtensionCol, int *extnameCol, int *extverCol, + int *positionCol, int *locationCol, int *uriCol, int *grptype, + int *status); + +int ffgmul(fitsfile *mfptr, int rmopt, int *status); + +int ffgmf(fitsfile *gfptr, char *xtension, char *extname, int extver, + int position, char *location, long *member, int *status); + +int ffgtrmr(fitsfile *gfptr, HDUtracker *HDU, int *status); + +int ffgtcpr(fitsfile *infptr, fitsfile *outfptr, int cpopt, HDUtracker *HDU, + int *status); + +int fftsad(fitsfile *mfptr, HDUtracker *HDU, int *newPosition, + char *newFileName); + +int fftsud(fitsfile *mfptr, HDUtracker *HDU, int newPosition, + char *newFileName); + +void prepare_keyvalue(char *keyvalue); + +int fits_path2url(char *inpath, char *outpath, int *status); + +int fits_url2path(char *inpath, char *outpath, int *status); + +int fits_get_cwd(char *cwd, int *status); + +int fits_get_url(fitsfile *fptr, char *realURL, char *startURL, + char *realAccess, char *startAccess, int *iostate, + int *status); + +int fits_clean_url(char *inURL, char *outURL, int *status); + +int fits_relurl2url(char *refURL, char *relURL, char *absURL, int *status); + +int fits_url2relurl(char *refURL, char *absURL, char *relURL, int *status); + +int fits_encode_url(char *inpath, char *outpath, int *status); + +int fits_unencode_url(char *inpath, char *outpath, int *status); + +int fits_is_url_absolute(char *url); + diff --git a/src/include/grparser.h b/src/include/grparser.h new file mode 100644 index 0000000..32a172b --- /dev/null +++ b/src/include/grparser.h @@ -0,0 +1,181 @@ +/* T E M P L A T E P A R S E R H E A D E R F I L E + ===================================================== + + by Jerzy.Borkowski@obs.unige.ch + + Integral Science Data Center + ch. d'Ecogia 16 + 1290 Versoix + Switzerland + +14-Oct-98: initial release +16-Oct-98: reference to fitsio.h removed, also removed strings after #endif + directives to make gcc -Wall not to complain +20-Oct-98: added declarations NGP_XTENSION_SIMPLE and NGP_XTENSION_FIRST +24-Oct-98: prototype of ngp_read_line() function updated. +22-Jan-99: prototype for ngp_set_extver() function added. +*/ + +#ifndef GRPARSER_H_INCLUDED +#define GRPARSER_H_INCLUDED + +#ifdef __cplusplus +extern "C" { +#endif + + /* error codes - now defined in fitsio.h */ + + /* common constants definitions */ + +#define NGP_ALLOCCHUNK (1000) +#define NGP_MAX_INCLUDE (10) /* include file nesting limit */ +#define NGP_MAX_COMMENT (80) /* max size for comment */ +#define NGP_MAX_NAME (20) /* max size for KEYWORD (FITS limits it to 8 chars) */ +#define NGP_MAX_STRING (80) /* max size for various strings */ +#define NGP_MAX_ARRAY_DIM (999) /* max. number of dimensions in array */ +#define NGP_MAX_FNAME (1000) /* max size of combined path+fname */ +#define NGP_MAX_ENVFILES (10000) /* max size of CFITSIO_INCLUDE_FILES env. variable */ + +#define NGP_TOKEN_UNKNOWN (-1) /* token type unknown */ +#define NGP_TOKEN_INCLUDE (0) /* \INCLUDE token */ +#define NGP_TOKEN_GROUP (1) /* \GROUP token */ +#define NGP_TOKEN_END (2) /* \END token */ +#define NGP_TOKEN_XTENSION (3) /* XTENSION token */ +#define NGP_TOKEN_SIMPLE (4) /* SIMPLE token */ +#define NGP_TOKEN_EOF (5) /* End Of File pseudo token */ + +#define NGP_TTYPE_UNKNOWN (0) /* undef (yet) token type - invalid to print/write to disk */ +#define NGP_TTYPE_BOOL (1) /* boolean, it is 'T' or 'F' */ +#define NGP_TTYPE_STRING (2) /* something withing "" or starting with letter */ +#define NGP_TTYPE_INT (3) /* starting with digit and not with '.' */ +#define NGP_TTYPE_REAL (4) /* digits + '.' */ +#define NGP_TTYPE_COMPLEX (5) /* 2 reals, separated with ',' */ +#define NGP_TTYPE_NULL (6) /* NULL token, format is : NAME = / comment */ +#define NGP_TTYPE_RAW (7) /* HISTORY/COMMENT/8SPACES + comment string without / */ + +#define NGP_FOUND_EQUAL_SIGN (1) /* line contains '=' after keyword name */ + +#define NGP_FORMAT_OK (0) /* line format OK */ +#define NGP_FORMAT_ERROR (1) /* line format error */ + +#define NGP_NODE_INVALID (0) /* default node type - invalid (to catch errors) */ +#define NGP_NODE_IMAGE (1) /* IMAGE type */ +#define NGP_NODE_ATABLE (2) /* ASCII table type */ +#define NGP_NODE_BTABLE (3) /* BINARY table type */ + +#define NGP_NON_SYSTEM_ONLY (0) /* save all keywords except NAXIS,BITPIX,etc.. */ +#define NGP_REALLY_ALL (1) /* save really all keywords */ + +#define NGP_XTENSION_SIMPLE (1) /* HDU defined with SIMPLE T */ +#define NGP_XTENSION_FIRST (2) /* this is first extension in template */ + +#define NGP_LINE_REREAD (1) /* reread line */ + +#define NGP_BITPIX_INVALID (-12345) /* default BITPIX (to catch errors) */ + + /* common macro definitions */ + +#ifdef NGP_PARSER_DEBUG_MALLOC + +#define ngp_alloc(x) dal_malloc(x) +#define ngp_free(x) dal_free(x) +#define ngp_realloc(x,y) dal_realloc(x,y) + +#else + +#define ngp_alloc(x) malloc(x) +#define ngp_free(x) free(x) +#define ngp_realloc(x,y) realloc(x,y) + +#endif + + /* type definitions */ + +typedef struct NGP_RAW_LINE_STRUCT + { char *line; + char *name; + char *value; + int type; + char *comment; + int format; + int flags; + } NGP_RAW_LINE; + + +typedef union NGP_TOKVAL_UNION + { char *s; /* space allocated separately, be careful !!! */ + char b; + int i; + double d; + struct NGP_COMPLEX_STRUCT + { double re; + double im; + } c; /* complex value */ + } NGP_TOKVAL; + + +typedef struct NGP_TOKEN_STRUCT + { int type; + char name[NGP_MAX_NAME]; + NGP_TOKVAL value; + char comment[NGP_MAX_COMMENT]; + } NGP_TOKEN; + + +typedef struct NGP_HDU_STRUCT + { int tokcnt; + NGP_TOKEN *tok; + } NGP_HDU; + + +typedef struct NGP_TKDEF_STRUCT + { char *name; + int code; + } NGP_TKDEF; + + +typedef struct NGP_EXTVER_TAB_STRUCT + { char *extname; + int version; + } NGP_EXTVER_TAB; + + + /* globally visible variables declarations */ + +extern NGP_RAW_LINE ngp_curline; +extern NGP_RAW_LINE ngp_prevline; + +extern int ngp_extver_tab_size; +extern NGP_EXTVER_TAB *ngp_extver_tab; + + + /* globally visible functions declarations */ + +int ngp_get_extver(char *extname, int *version); +int ngp_set_extver(char *extname, int version); +int ngp_delete_extver_tab(void); +int ngp_strcasecmp(char *p1, char *p2); +int ngp_line_from_file(FILE *fp, char **p); +int ngp_free_line(void); +int ngp_free_prevline(void); +int ngp_read_line_buffered(FILE *fp); +int ngp_unread_line(void); +int ngp_extract_tokens(NGP_RAW_LINE *cl); +int ngp_include_file(char *fname); +int ngp_read_line(int ignore_blank_lines); +int ngp_keyword_is_write(NGP_TOKEN *ngp_tok); +int ngp_keyword_all_write(NGP_HDU *ngph, fitsfile *ffp, int mode); +int ngp_hdu_init(NGP_HDU *ngph); +int ngp_hdu_clear(NGP_HDU *ngph); +int ngp_hdu_insert_token(NGP_HDU *ngph, NGP_TOKEN *newtok); +int ngp_append_columns(fitsfile *ff, NGP_HDU *ngph, int aftercol); +int ngp_read_xtension(fitsfile *ff, int parent_hn, int simple_mode); +int ngp_read_group(fitsfile *ff, char *grpname, int parent_hn); + + /* top level API function - now defined in fitsio.h */ + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/src/include/imcompress.h b/src/include/imcompress.h new file mode 100644 index 0000000..c5ba7d2 --- /dev/null +++ b/src/include/imcompress.h @@ -0,0 +1,56 @@ +#define MAX_COMPRESS_DIM 6 +#define COMPRESS_NULL_VALUE -2147483647 + +typedef struct { + char zcmptype[12]; /* compression type string */ + int compress_type; /* type of compression algorithm */ + int bitpix; /* FITS data type of image (BITPIX) */ + int ndim; /* dimension of image */ + long naxis[MAX_COMPRESS_DIM]; /* length of each axis */ + int cn_compressed; /* column number for COMPRESSED_DATA column */ + int cn_uncompressed; /* column number for UNCOMPRESSED_DATA column */ + int cn_zscale; /* column number for CSCALE column */ + int cn_zzero; /* column number for CZERO column */ + int cn_zblank; /* column number for the CBLANK column */ + double zscale; /* scaling value, if keyword and not column */ + double zzero; /* zero pt, if keyword and not column */ + int zblank; /* value for null pixels, if not a column */ + long nrows; /* number of rows in table */ + int ncols; /* number of columns in table */ + int rice_blocksize; /* first compression parameter */ + int rice_nbits; /* second compression parameter */ + long tilesize[MAX_COMPRESS_DIM]; /* size of compression tiles */ + long maxtilelen; /* max number of pixels in each image tile */ + long maxelem; /* maximum length of variable length arrays */ +} CompressImageInfo; + +/* image compression routines */ +static int imcomp_get_image_params(fitsfile *infptr, CompressImageInfo *otb, + int *status); +static int imcomp_init_table(fitsfile *outfptr, + CompressImageInfo *otb, int *status); +static int imcomp_calc_max_elem (int nx, int blocksize); +static int imcomp_copy_imheader(fitsfile *infptr, fitsfile *outfptr, + int *status); +static int imcomp_img_to_tbl_special (char *card); +static int imcomp_compress_image (fitsfile *infptr, fitsfile *outfptr, + CompressImageInfo *otb, int *status); + +/* image decompression routines */ +int fits_read_compressed_img_plane(fitsfile *fptr, int datatype, + int bytesperpixel, long nplane, long *firstcoord, long *lastcoord, + long *inc, long *naxes, int nullcheck, void *nullval, + void *array, char *nullarray, int *anynul, int *status); +static int imcomp_get_table_params(fitsfile *infptr, CompressImageInfo *itb, + int *status); +static int imcomp_copy_tblheader(fitsfile *infptr, fitsfile *outfptr, + int *status); +static int imcomp_tbl_to_img_special (char *keyname); +static int imcomp_decompress_tile (fitsfile *infptr, CompressImageInfo *itb, + int nrow, int tilesize, int datatype, int nullcheck, + void *nulval, void *buffer, char *bnullarray, int *anynul, + int *status); +static int imcomp_copy_overlap (char *tile, int datatype, int ndim, + long *tfpixel, long *tlpixel, char *bnullarray, char *image, + long *fpixel, long *lpixel, int nullcheck, char *nullarray, + int *status); diff --git a/src/include/longnam.h b/src/include/longnam.h new file mode 100644 index 0000000..ac083bc --- /dev/null +++ b/src/include/longnam.h @@ -0,0 +1,476 @@ +#ifndef _LONGNAME_H +#define _LONGNAME_H + +#define fits_parse_input_url ffiurl +#define fits_parse_rootname ffrtnm +#define fits_parse_output_url ffourl +#define fits_parse_extspec ffexts +#define fits_parse_extnum ffextn +#define fits_parse_binspec ffbins +#define fits_parse_binrange ffbinr +#define fits_open_memfile ffomem +#define fits_open_file ffopen +#define fits_reopen_file ffreopen +#define fits_create_file ffinit +#define fits_create_template fftplt +#define fits_flush_file ffflus +#define fits_close_file ffclos +#define fits_delete_file ffdelt +#define fits_file_name ffflnm +#define fits_file_mode ffflmd +#define fits_url_type ffurlt + +#define fits_get_version ffvers +#define fits_uppercase ffupch +#define fits_get_errstatus ffgerr +#define fits_write_errmsg ffpmsg +#define fits_read_errmsg ffgmsg +#define fits_clear_errmsg ffcmsg +#define fits_report_error ffrprt +#define fits_compare_str ffcmps +#define fits_test_keyword fftkey +#define fits_test_record fftrec +#define fits_null_check ffnchk +#define fits_make_keyn ffkeyn +#define fits_make_nkey ffnkey +#define fits_get_keyclass ffgkcl +#define fits_get_keytype ffdtyp +#define fits_parse_value ffpsvc +#define fits_get_keyname ffgknm +#define fits_parse_template ffgthd +#define fits_ascii_tform ffasfm +#define fits_binary_tform ffbnfm +#define fits_get_tbcol ffgabc +#define fits_get_rowsize ffgrsz +#define fits_get_col_display_width ffgcdw + +#define fits_write_record ffprec +#define fits_write_key ffpky +#define fits_write_key_unit ffpunt +#define fits_write_comment ffpcom +#define fits_write_history ffphis +#define fits_write_date ffpdat +#define fits_get_system_time ffgstm +#define fits_get_system_date ffgsdt +#define fits_date2str ffdt2s +#define fits_time2str fftm2s +#define fits_str2date ffs2dt +#define fits_str2time ffs2tm +#define fits_write_key_longstr ffpkls +#define fits_write_key_longwarn ffplsw +#define fits_write_key_null ffpkyu +#define fits_write_key_str ffpkys +#define fits_write_key_log ffpkyl +#define fits_write_key_lng ffpkyj +#define fits_write_key_fixflt ffpkyf +#define fits_write_key_flt ffpkye +#define fits_write_key_fixdbl ffpkyg +#define fits_write_key_dbl ffpkyd +#define fits_write_key_fixcmp ffpkfc +#define fits_write_key_cmp ffpkyc +#define fits_write_key_fixdblcmp ffpkfm +#define fits_write_key_dblcmp ffpkym +#define fits_write_key_triple ffpkyt +#define fits_write_tdim ffptdm +#define fits_write_keys_str ffpkns +#define fits_write_keys_log ffpknl +#define fits_write_keys_lng ffpknj +#define fits_write_keys_fixflt ffpknf +#define fits_write_keys_flt ffpkne +#define fits_write_keys_fixdbl ffpkng +#define fits_write_keys_dbl ffpknd +#define fits_copy_key ffcpky +#define fits_write_imghdr ffphps +#define fits_write_grphdr ffphpr +#define fits_write_atblhdr ffphtb +#define fits_write_btblhdr ffphbn +#define fits_write_key_template ffpktp + +#define fits_get_hdrspace ffghsp +#define fits_get_hdrpos ffghps +#define fits_movabs_key ffmaky +#define fits_movrel_key ffmrky +#define fits_find_nextkey ffgnxk + +#define fits_read_record ffgrec +#define fits_read_card ffgcrd +#define fits_read_key_unit ffgunt +#define fits_read_keyn ffgkyn +#define fits_read_key ffgky +#define fits_read_keyword ffgkey +#define fits_read_key_str ffgkys +#define fits_read_key_log ffgkyl +#define fits_read_key_lng ffgkyj +#define fits_read_key_flt ffgkye +#define fits_read_key_dbl ffgkyd +#define fits_read_key_cmp ffgkyc +#define fits_read_key_dblcmp ffgkym +#define fits_read_key_triple ffgkyt +#define fits_read_key_longstr ffgkls +#define fits_read_tdim ffgtdm +#define fits_decode_tdim ffdtdm +#define fits_read_keys_str ffgkns +#define fits_read_keys_log ffgknl +#define fits_read_keys_lng ffgknj +#define fits_read_keys_flt ffgkne +#define fits_read_keys_dbl ffgknd +#define fits_read_imghdr ffghpr +#define fits_read_atblhdr ffghtb +#define fits_read_btblhdr ffghbn +#define fits_header2str ffh2st + +#define fits_update_card ffucrd +#define fits_update_key ffuky +#define fits_update_key_null ffukyu +#define fits_update_key_str ffukys +#define fits_update_key_longstr ffukls +#define fits_update_key_log ffukyl +#define fits_update_key_lng ffukyj +#define fits_update_key_fixflt ffukyf +#define fits_update_key_flt ffukye +#define fits_update_key_fixdbl ffukyg +#define fits_update_key_dbl ffukyd +#define fits_update_key_fixcmp ffukfc +#define fits_update_key_cmp ffukyc +#define fits_update_key_fixdblcmp ffukfm +#define fits_update_key_dblcmp ffukym + +#define fits_modify_record ffmrec +#define fits_modify_card ffmcrd +#define fits_modify_name ffmnam +#define fits_modify_comment ffmcom +#define fits_modify_key_null ffmkyu +#define fits_modify_key_str ffmkys +#define fits_modify_key_longstr ffmkls +#define fits_modify_key_log ffmkyl +#define fits_modify_key_lng ffmkyj +#define fits_modify_key_fixflt ffmkyf +#define fits_modify_key_flt ffmkye +#define fits_modify_key_fixdbl ffmkyg +#define fits_modify_key_dbl ffmkyd +#define fits_modify_key_fixcmp ffmkfc +#define fits_modify_key_cmp ffmkyc +#define fits_modify_key_fixdblcmp ffmkfm +#define fits_modify_key_dblcmp ffmkym + +#define fits_insert_record ffirec +#define fits_insert_key_null ffikyu +#define fits_insert_key_str ffikys +#define fits_insert_key_longstr ffikls +#define fits_insert_key_log ffikyl +#define fits_insert_key_lng ffikyj +#define fits_insert_key_fixflt ffikyf +#define fits_insert_key_flt ffikye +#define fits_insert_key_fixdbl ffikyg +#define fits_insert_key_dbl ffikyd +#define fits_insert_key_fixcmp ffikfc +#define fits_insert_key_cmp ffikyc +#define fits_insert_key_fixdblcmp ffikfm +#define fits_insert_key_dblcmp ffikym + +#define fits_delete_key ffdkey +#define fits_delete_record ffdrec +#define fits_get_hdu_num ffghdn +#define fits_get_hdu_type ffghdt +#define fits_get_hduaddr ffghad + +#define fits_get_img_param ffgipr +#define fits_get_img_type ffgidt +#define fits_get_img_dim ffgidm +#define fits_get_img_size ffgisz + +#define fits_movabs_hdu ffmahd +#define fits_movrel_hdu ffmrhd +#define fits_movnam_hdu ffmnhd +#define fits_get_num_hdus ffthdu +#define fits_create_img ffcrim +#define fits_create_tbl ffcrtb +#define fits_create_hdu ffcrhd +#define fits_insert_img ffiimg +#define fits_insert_atbl ffitab +#define fits_insert_btbl ffibin +#define fits_resize_img ffrsim +#define fits_delete_hdu ffdhdu +#define fits_copy_hdu ffcopy +#define fits_copy_header ffcphd +#define fits_copy_data ffcpdt + +#define fits_set_hdustruc ffrdef +#define fits_set_hdrsize ffhdef +#define fits_write_theap ffpthp + +#define fits_encode_chksum ffesum +#define fits_decode_chksum ffdsum +#define fits_write_chksum ffpcks +#define fits_update_chksum ffupck +#define fits_verify_chksum ffvcks +#define fits_get_chksum ffgcks + +#define fits_set_bscale ffpscl +#define fits_set_tscale fftscl +#define fits_set_imgnull ffpnul +#define fits_set_btblnull fftnul +#define fits_set_atblnull ffsnul + +#define fits_get_colnum ffgcno +#define fits_get_colname ffgcnn +#define fits_get_coltype ffgtcl +#define fits_get_num_rows ffgnrw +#define fits_get_num_cols ffgncl +#define fits_get_acolparms ffgacl +#define fits_get_bcolparms ffgbcl + +#define fits_iterate_data ffiter + +#define fits_read_grppar_byt ffggpb +#define fits_read_grppar_usht ffggpui +#define fits_read_grppar_ulng ffggpuj +#define fits_read_grppar_sht ffggpi +#define fits_read_grppar_lng ffggpj +#define fits_read_grppar_int ffggpk +#define fits_read_grppar_uint ffggpuk +#define fits_read_grppar_flt ffggpe +#define fits_read_grppar_dbl ffggpd + +#define fits_read_img ffgpv +#define fits_read_imgnull ffgpf +#define fits_read_img_byt ffgpvb +#define fits_read_img_usht ffgpvui +#define fits_read_img_ulng ffgpvuj +#define fits_read_img_sht ffgpvi +#define fits_read_img_lng ffgpvj +#define fits_read_img_uint ffgpvuk +#define fits_read_img_int ffgpvk +#define fits_read_img_flt ffgpve +#define fits_read_img_dbl ffgpvd + +#define fits_read_imgnull_byt ffgpfb +#define fits_read_imgnull_usht ffgpfui +#define fits_read_imgnull_ulng ffgpfuj +#define fits_read_imgnull_sht ffgpfi +#define fits_read_imgnull_lng ffgpfj +#define fits_read_imgnull_uint ffgpfuk +#define fits_read_imgnull_int ffgpfk +#define fits_read_imgnull_flt ffgpfe +#define fits_read_imgnull_dbl ffgpfd + +#define fits_read_2d_byt ffg2db +#define fits_read_2d_usht ffg2dui +#define fits_read_2d_ulng ffg2duj +#define fits_read_2d_sht ffg2di +#define fits_read_2d_lng ffg2dj +#define fits_read_2d_uint ffg2duk +#define fits_read_2d_int ffg2dk +#define fits_read_2d_flt ffg2de +#define fits_read_2d_dbl ffg2dd + +#define fits_read_3d_byt ffg3db +#define fits_read_3d_usht ffg3dui +#define fits_read_3d_ulng ffg3duj +#define fits_read_3d_sht ffg3di +#define fits_read_3d_lng ffg3dj +#define fits_read_3d_uint ffg3duk +#define fits_read_3d_int ffg3dk +#define fits_read_3d_flt ffg3de +#define fits_read_3d_dbl ffg3dd + +#define fits_read_subset_byt ffgsvb +#define fits_read_subset_usht ffgsvui +#define fits_read_subset_ulng ffgsvuj +#define fits_read_subset_sht ffgsvi +#define fits_read_subset_lng ffgsvj +#define fits_read_subset_uint ffgsvuk +#define fits_read_subset_int ffgsvk +#define fits_read_subset_flt ffgsve +#define fits_read_subset_dbl ffgsvd + +#define fits_read_subsetnull_byt ffgsfb +#define fits_read_subsetnull_usht ffgsfui +#define fits_read_subsetnull_ulng ffgsfuj +#define fits_read_subsetnull_sht ffgsfi +#define fits_read_subsetnull_lng ffgsfj +#define fits_read_subsetnull_uint ffgsfuk +#define fits_read_subsetnull_int ffgsfk +#define fits_read_subsetnull_flt ffgsfe +#define fits_read_subsetnull_dbl ffgsfd + +#define fits_read_col ffgcv +#define fits_read_colnull ffgcf +#define fits_read_col_str ffgcvs +#define fits_read_col_log ffgcvl +#define fits_read_col_byt ffgcvb +#define fits_read_col_usht ffgcvui +#define fits_read_col_ulng ffgcvuj +#define fits_read_col_sht ffgcvi +#define fits_read_col_lng ffgcvj +#define fits_read_col_uint ffgcvuk +#define fits_read_col_int ffgcvk +#define fits_read_col_flt ffgcve +#define fits_read_col_dbl ffgcvd +#define fits_read_col_cmp ffgcvc +#define fits_read_col_dblcmp ffgcvm +#define fits_read_col_bit ffgcx +#define fits_read_col_bit_usht ffgcxui +#define fits_read_col_bit_uint ffgcxuk + +#define fits_read_colnull_str ffgcfs +#define fits_read_colnull_log ffgcfl +#define fits_read_colnull_byt ffgcfb +#define fits_read_colnull_usht ffgcfui +#define fits_read_colnull_ulng ffgcfuj +#define fits_read_colnull_sht ffgcfi +#define fits_read_colnull_lng ffgcfj +#define fits_read_colnull_uint ffgcfuk +#define fits_read_colnull_int ffgcfk +#define fits_read_colnull_flt ffgcfe +#define fits_read_colnull_dbl ffgcfd +#define fits_read_colnull_cmp ffgcfc +#define fits_read_colnull_dblcmp ffgcfm + +#define fits_read_descript ffgdes +#define fits_read_descripts ffgdess +#define fits_read_tblbytes ffgtbb + +#define fits_write_grppar_byt ffpgpb +#define fits_write_grppar_usht ffpgpui +#define fits_write_grppar_ulng ffpgpuj +#define fits_write_grppar_sht ffpgpi +#define fits_write_grppar_lng ffpgpj +#define fits_write_grppar_uint ffpgpuk +#define fits_write_grppar_int ffpgpk +#define fits_write_grppar_flt ffpgpe +#define fits_write_grppar_dbl ffpgpd + +#define fits_write_img ffppr +#define fits_write_img_byt ffpprb +#define fits_write_img_usht ffpprui +#define fits_write_img_ulng ffppruj +#define fits_write_img_sht ffppri +#define fits_write_img_lng ffpprj +#define fits_write_img_uint ffppruk +#define fits_write_img_int ffpprk +#define fits_write_img_flt ffppre +#define fits_write_img_dbl ffpprd + +#define fits_write_imgnull ffppn +#define fits_write_imgnull_byt ffppnb +#define fits_write_imgnull_usht ffppnui +#define fits_write_imgnull_ulng ffppnuj +#define fits_write_imgnull_sht ffppni +#define fits_write_imgnull_lng ffppnj +#define fits_write_imgnull_uint ffppnuk +#define fits_write_imgnull_int ffppnk +#define fits_write_imgnull_flt ffppne +#define fits_write_imgnull_dbl ffppnd + +#define fits_write_img_null ffppru +#define fits_write_null_img ffpprn + +#define fits_write_2d_byt ffp2db +#define fits_write_2d_usht ffp2dui +#define fits_write_2d_ulng ffp2duj +#define fits_write_2d_sht ffp2di +#define fits_write_2d_lng ffp2dj +#define fits_write_2d_uint ffp2duk +#define fits_write_2d_int ffp2dk +#define fits_write_2d_flt ffp2de +#define fits_write_2d_dbl ffp2dd + +#define fits_write_3d_byt ffp3db +#define fits_write_3d_usht ffp3dui +#define fits_write_3d_ulng ffp3duj +#define fits_write_3d_sht ffp3di +#define fits_write_3d_lng ffp3dj +#define fits_write_3d_uint ffp3duk +#define fits_write_3d_int ffp3dk +#define fits_write_3d_flt ffp3de +#define fits_write_3d_dbl ffp3dd + +#define fits_write_subset_byt ffpssb +#define fits_write_subset_usht ffpssui +#define fits_write_subset_ulng ffpssuj +#define fits_write_subset_sht ffpssi +#define fits_write_subset_lng ffpssj +#define fits_write_subset_uint ffpssuk +#define fits_write_subset_int ffpssk +#define fits_write_subset_flt ffpsse +#define fits_write_subset_dbl ffpssd + +#define fits_write_col ffpcl +#define fits_write_col_str ffpcls +#define fits_write_col_log ffpcll +#define fits_write_col_byt ffpclb +#define fits_write_col_usht ffpclui +#define fits_write_col_ulng ffpcluj +#define fits_write_col_sht ffpcli +#define fits_write_col_lng ffpclj +#define fits_write_col_uint ffpcluk +#define fits_write_col_int ffpclk +#define fits_write_col_flt ffpcle +#define fits_write_col_dbl ffpcld +#define fits_write_col_cmp ffpclc +#define fits_write_col_dblcmp ffpclm +#define fits_write_col_null ffpclu +#define fits_write_col_bit ffpclx + +#define fits_write_colnull ffpcn +#define fits_write_colnull_str ffpcns +#define fits_write_colnull_log ffpcnl +#define fits_write_colnull_byt ffpcnb +#define fits_write_colnull_usht ffpcnui +#define fits_write_colnull_ulng ffpcnuj +#define fits_write_colnull_sht ffpcni +#define fits_write_colnull_lng ffpcnj +#define fits_write_colnull_uint ffpcnuk +#define fits_write_colnull_int ffpcnk +#define fits_write_colnull_flt ffpcne +#define fits_write_colnull_dbl ffpcnd + +#define fits_write_descript ffpdes + +#define fits_write_tblbytes ffptbb +#define fits_insert_rows ffirow +#define fits_delete_rows ffdrow +#define fits_delete_rowlist ffdrws +#define fits_insert_col fficol +#define fits_insert_cols fficls +#define fits_delete_col ffdcol +#define fits_copy_col ffcpcl +#define fits_modify_vector_len ffmvec + +#define fits_read_img_coord ffgics +#define fits_read_tbl_coord ffgtcs +#define fits_pix_to_world ffwldp +#define fits_world_to_pix ffxypx + +#define fits_get_image_wcs_keys ffgiwcs +#define fits_get_table_wcs_keys ffgtwcs + +#define fits_find_rows fffrow +#define fits_find_first_row ffffrw +#define fits_find_rows_cmp fffrwc +#define fits_select_rows ffsrow +#define fits_calc_rows ffcrow +#define fits_calculator ffcalc +#define fits_calculator_rng ffcalc_rng +#define fits_test_expr fftexp + +#define fits_create_group ffgtcr +#define fits_insert_group ffgtis +#define fits_change_group ffgtch +#define fits_remove_group ffgtrm +#define fits_copy_group ffgtcp +#define fits_merge_groups ffgtmg +#define fits_compact_group ffgtcm +#define fits_verify_group ffgtvf +#define fits_open_group ffgtop +#define fits_add_group_member ffgtam +#define fits_get_num_members ffgtnm + +#define fits_get_num_groups ffgmng +#define fits_open_member ffgmop +#define fits_copy_member ffgmcp +#define fits_transfer_member ffgmtf +#define fits_remove_member ffgmrm + +#endif diff --git a/src/include/pctype.h b/src/include/pctype.h new file mode 100644 index 0000000..2ef4a67 --- /dev/null +++ b/src/include/pctype.h @@ -0,0 +1,155 @@ +/* + * These ones are necessary to override the behaviour of + * PINT_cfB, which puts the & on before getting to the + * TYPE specific PCINT_cfPP... + * The only way to do this is to introduce PCDOUBLE_cfINT, + * which means we use PCINT for alot of the generic macros. + */ + +#define PCINT_cfAA PINT_cfAA +#define PCINT_cfN PINT_cfN +#define PCINT_cfV PINT_cfV +#define PCINT_cfZ(T,I,A) (__cfztringv[I]= (int ) *A), +#define PCINT_cfSEP INT_cfSEP +#define PCINT_cfCC PINT_cfCC +#define PCINT_cfB(T,A) _(T,_cfPP) A +#define PCINT_cfU PINT_cfU + +/* These are the real TYPE specific ones, and will need to be + * duplicated for FLOAT,... + */ +#define PCINT_cfINT PCDOUBLE_cfINT +#define PCINT_cfAAP(A, B) A +#define PCINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PCINT_cfTYPE int +#define PCINT_cfVP(A,B) int B = (int) *A; /* For ZSTRINGV_ARGS */ +#define PCINT_cfPP +#define PCINT_cfCCC(A,B) A + +#define PCFLOAT_cfINT PCDOUBLE_cfINT +#define PCFLOAT_cfAAP(A, B) A +#define PCFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PCFLOAT_cfTYPE float +#define PCFLOAT_cfVP PCINT_cfVP /* For ZSTRINGV_ARGS */ +#define PCFLOAT_cfPP +#define PCFLOAT_cfCCC(A,B) A + +#define PCDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PCINT,B,X,Y,Z,0) +#define PCDOUBLE_cfAAP(A, B) A +#define PCDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) +#define PCDOUBLE_cfTYPE double +#define PCDOUBLE_cfVP PCINT_cfVP /* For ZSTRINGV_ARGS */ +#define PCDOUBLE_cfPP +#define PCDOUBLE_cfCCC(A,B) A + +#define PCLOGICAL_cfINT PCDOUBLE_cfINT +#define PCLOGICAL_cfA(M,I,A,B) *A=C2FLOGICAL(*A); +#define PCLOGICAL_cfAAP(A,B) B = A +#define PCLOGICAL_cfC(A,B,C) *A=C2FLOGICAL(*A); +#define PCLOGICAL_cfH(S,U,B) +#define PCLOGICAL_cfJ(B) +#define PCLOGICAL_cfW(A,B) PLOGICAL_cfW(A,B) +#define PCLOGICAL_cfS(M,I,A) +#define PCLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PCLOGICAL,A,B,C,D,E) +#define PCLOGICAL_cfTYPE int +#define PCLOGICAL_cfVP PLOGICAL_cfVP /* For ZSTRINGV_ARGS */ +#define PCLOGICAL_cfPP +#define PCLOGICAL_cfKK PLOGICAL_cfKK +#define PCLOGICAL_cfCCC(A,B) B = A + +/* + * I can't find where the following three defines are used... + * So they may well be wrong. + */ + +#define PCLOGICAL_cfQ(B) +#define PCLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A); +#define PCLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A) + +/* This is to get PZTRINGS to work for dynamically allocated + * Contiguous arrays... The problem was that the array is massaged + * coming in with the call: c2fstrv( A[0], A[0],... ) + * and coming out with: f2cstrv( (char *) A, (char *) A,... ) + * + * If you dynamically allocate an array with the trick: + * + * char ** A; + * A = (char **) malloc ( nelements * sizeof(char *) ); + * A[0] = (char *) malloc (nelements * elemSize * sizeof (char) ); + * for ( i = 1; i < nelements; i++) A[i] = A[0] + i * elemSize; + * + * Then the coming in call will kill you if you pass in A, and the + * coming out call will kill you if you pass in A[0]... + * So, I change the coming in call to (char *)A, and you must then + * pass in A[0]. + * + */ + + +#undef PZTRINGV_cfA +#define PZTRINGV_cfA(M,I,A,B) APAZTRINGV_cfA(M,I,A,B, \ + (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \ + (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1) +#ifdef vmsFortran +#define AAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \ + initfstr(B,malloc((sA)-(filA)),(filA),(silA)-1), \ c2fstrv((char *) A,B.dsc$a_pointer,(silA),(sA)); +#define APAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \ + initfstr(B,(char *) A,(filA),(silA)-1),c2fstrv((char *) A,(char *)A,(silA),(sA)); +#else +#define AAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \ + (B.s=malloc((sA)-(filA)),B.fs=c2fstrv((char *)A,B.s,(B.flen=(silA)-1)+1,(sA))); +#define APAZTRINGV_cfA(M,I,A,B, sA,filA,silA) \ + B.fs=c2fstrv((char *) A,(char *) A,(B.flen=(silA)-1)+1,B.sizeofA=(sA)); +#endif + + +/* + * This allows for character arrays longer than an unsigned short... + */ + +#ifndef vmsFortran +#undef STRING_cfV +#undef PSTRINGV_cfV +#define STRING_cfV(T,A,B,F) struct {unsigned int clen, flen;} B; +#define PSTRINGV_cfV(T,A,B,F) struct {char *fs; unsigned int sizeofA, flen;} B; +#endif + +/* + * This is to introduce a PZTRING ( NO V ) type + */ + + +#ifdef vmsFortran +#define PZTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL}; +#define APATRING_cfA(M,I,A,B,silA) \ + (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A, \ + B.dsc$w_length >= silA?0:(memset((A)+B.dsc$w_length,' ',silA-B.dsc$w_length-1), \ + A[B.dsc$w_length=silA-1]='\0')); +#define PZTRING_cfC(A,B,C) \ + (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A, \ + B.dsc$w_length >= C?0:(memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), \ + A[B.dsc$w_length=C-1]='\0')); +#else +#define PZTRING_cfV(T,A,B,F) int B; +#define APATRING_cfA(M,I,A,B,silA) \ + (B=strlen(A),B >= silA?0:(memset((A)+B,' ',silA-B-1)),A[B = silA - 1]='\0'); +#define PZTRING_cfC(A,B,C) \ + (B=strlen(A),B > C?0:(memset((A)+B,' ',(C - 1)-B-1)),A[B = C - 1]='\0'); +#endif + +#define PZTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRING,A,B,C,D,E) +#define PZTRING_cfINT PVOID_cfINT +#define PZTRING_cfA(M,I,A,B) APATRING_cfA(M,I,A,B,(_3(M,_ELEMLEN_,I))+1) +#define PZTRING_cfAA PSTRING_cfCC +#define PZTRING_cfB PSTRING_cfB + +#define PZTRING_cfCC PSTRING_cfCC +#define PZTRING_cfJ PSTRING_cfJ +#define PZTRING_cfH STRING_cfH +#define PZTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */ +#define PZTRING_cfS(M,I,A) ,( _3(M,_ELEMLEN_,I) + 1 ) +#define PZTRING_cfU(T,A) char *A +#define PZTRING_cfW(A,B) kill_trailing(A,' '); +#define PZTRING_cfZ(T,I,A) +#define PZTRING_cfSEP INT_cfSEP +#define PZTRING_cfKK STRING_cfKK diff --git a/src/include/region.h b/src/include/region.h new file mode 100644 index 0000000..4d7c96c --- /dev/null +++ b/src/include/region.h @@ -0,0 +1,80 @@ +/***************************************************************/ +/* REGION STUFF */ +/***************************************************************/ + +#define myPI 3.1415926535897932385 + +typedef struct { + int exists; + double xrefval, yrefval; + double xrefpix, yrefpix; + double xinc, yinc; + double rot; + char type[6]; +} WCSdata; + +typedef enum { + point_rgn, + line_rgn, + circle_rgn, + annulus_rgn, + ellipse_rgn, + elliptannulus_rgn, + box_rgn, + rectangle_rgn, + diamond_rgn, + sector_rgn, + poly_rgn +} shapeType; + +typedef enum { pixel_fmt, degree_fmt, hhmmss_fmt } coordFmt; + +typedef struct { + char sign; /* Include or exclude? */ + shapeType shape; /* Shape of this region */ + + union { /* Parameters - In pixels */ + + /**** Generic Shape Data ****/ + + struct { + double p[8]; /* Region parameters */ + double sinT, cosT; /* For rotated shapes */ + double a, b; /* Extra scratch area */ + } gen; + + /**** Polygon Data ****/ + + struct { + int nPts; /* Number of Polygon pts */ + double *Pts; /* Polygon points */ + double xmin,xmax; /* Polygon bounding box */ + double ymin,ymax; + } poly; + + } param; + +} RgnShape; + +typedef struct { + int nShapes; + RgnShape *Shapes; + WCSdata wcs; +} SAORegion; + +#ifdef __cplusplus +extern "C" { +#endif + +int ffrrgn( const char *filename, WCSdata *wcs, SAORegion **Rgn, int *status ); +int fftrgn( double X, double Y, SAORegion *Rgn ); +void fffrgn( SAORegion *Rgn ); + +#ifdef __cplusplus + } +#endif + +#define fits_read_rgnfile ffrrgn +#define fits_in_region fftrgn +#define fits_free_region fffrgn + diff --git a/src/include/ricecomp.h b/src/include/ricecomp.h new file mode 100644 index 0000000..4a48328 --- /dev/null +++ b/src/include/ricecomp.h @@ -0,0 +1,107 @@ +/* @(#) buffer.h 1.1 98/07/21 12:34:27 */ +/* buffer.h: structure for compression to buffer rather than to a file, including + * bit I/O buffer + * + * R. White, 19 June 1998 + */ + + +typedef unsigned char Buffer_t; + +typedef struct { + int bitbuffer; /* bit buffer */ + int bits_to_go; /* bits to go in buffer */ + Buffer_t *start; /* start of buffer */ + Buffer_t *current; /* current position in buffer */ + Buffer_t *end; /* end of buffer */ +} Buffer; + +#define buffree(mf) (free(mf->start), free(mf)) +#define bufused(mf) (mf->current - mf->start) +#define bufreset(mf) (mf->current = mf->start) + +/* + * getcbuf, putcbuf macros for character IO to buffer + * putcbuf returns EOF on end of buffer, else returns 0 + */ +#define getcbuf(mf) ((mf->current >= mf->end) ? EOF : *(mf->current)++) +#define putcbuf(c,mf) \ + ((mf->current >= mf->end) ? \ + EOF :\ + ((*(mf->current)++ = c), 0)) + +/* + * bufalloc sets up buffer of length n + */ + +/* not needed by CFITSIO + +static Buffer *bufalloc(int n) +{ +Buffer *mf; + + mf = (Buffer *) malloc(sizeof(Buffer)); + if (mf == (Buffer *)NULL) return((Buffer *)NULL); + + mf->start = (Buffer_t *) malloc(n*sizeof(Buffer_t)); + if (mf->start == (Buffer_t *)NULL) { + free(mf); + return((Buffer *)NULL); + } + mf->bits_to_go = 8; + mf->end = mf->start + n; + mf->current = mf->start; + return(mf); +} +*/ + +/* + * bufrealloc extends buffer (or truncates it) by + * reallocating memory + */ + +/* not needed by CFITSIO +static int bufrealloc(Buffer *mf, int n) +{ +int len; + + len = mf->current - mf->start; + + * silently throw away data if buffer is already longer than n * + if (len>n) len = n; + if (len<0) len = 0; + + mf->start = (Buffer_t *) realloc(mf->start, n*sizeof(Buffer_t)); + if (mf->start == (Buffer_t *)NULL) return(0); + + mf->end = mf->start + n; + mf->current = mf->start + len; + return(n); +} +*/ + +/* + * bufdump dumps contents of buffer to outfile and resets + * it to be empty. Returns number of bytes written. + * + * Note we don't write out the bit buffer -- you must call + * done_outputing_bits() first to ensure that the bit buffer + * is written out. I do it this way to allow incremental + * buffer dumps while bit IO is still going on. + */ + +/* not needed by CFITSIO + +static int bufdump(FILE *outfile, Buffer *buffer) +{ +int ndump; + + ndump = bufused(buffer); + if (fwrite(buffer->start, 1, ndump, outfile) != ndump) { + fprintf(stderr, "bufdump: error in write\n"); + exit(1); + } + bufreset(buffer); + return(ndump); +} +*/ diff --git a/src/include/sgp4.h b/src/include/sgp4.h new file mode 100644 index 0000000..289b969 --- /dev/null +++ b/src/include/sgp4.h @@ -0,0 +1,62 @@ +/* H+ + * Title : sgp4.h + * Author : Bryce A. Roberts + * Date : 23 February 1999 + * Synopsis : header file for SGP4 propagation routines + * SCCS : @(#)sgp4.h 1.1 03/04/03 + * Revisions : + * mm/dd/yy name description + * H- + */ + +#ifndef _SGP4_H +#define _SGP4_H + +#include <math.h> +#include <stdlib.h> +#include <time.h> +#include <strings.h> + +#define MJD2000 (51544.0) + +/* the data structure itself */ +struct sgp4_st { + /* NORAD tle components */ + double epochTime, n0, n0dt, n0dt2, bstar, i0, raan, e0, w0, M0; + + /* derived variables */ + double n0dp, a0dp, q0ms4, theta, theta_2, zeta_4, beta0_2, eta, C1, + C1_2, C1_3, C1_4, C3, C4, C5, D2, D3, D4, mdot, wdot, raandot; + }; + +typedef struct sgp4_st * SGP4; + +/* create a new instance of SGP4 */ +extern SGP4 SGP4_create(void); + +/* destroy an instance of SGP4 */ +extern void SGP4_destroy(SGP4 sgp4); + +/* convert NORAD time string to TJD */ +extern int SGP4_getTime(const char *str, double *t); + +/* do time-invariant initializations */ +extern void SGP4_init(SGP4 sgp4); + +/* get a state vector at a point in time */ +extern void SGP4_getStateVector(SGP4 sgp4, double t, double pos[3], + double vel[3]); + +/* finds the pole (orbit plane normal) */ +extern void SGP4_getPole(double pos[3], double vel[3], double pole[3]); + +/* sets the elements of an instance of SGP4 */ +extern void SGP4_set(SGP4 sgp4, double epochTime, double n0dt, double n0dt2, + double bstar, double i0, double raan, double e0, + double w0, double M0, double n0); + +/* precesses a direction vector from t1 to t2 */ +void SGP4_precess(double v[3], double t1, double t2); + + +#endif diff --git a/src/include/slalib.h b/src/include/slalib.h new file mode 100644 index 0000000..1cba29a --- /dev/null +++ b/src/include/slalib.h @@ -0,0 +1,418 @@ +#ifndef SLALIBHDEF +#define SLALIBHDEF +#include <math.h> + +/* +** - - - - - - - - - +** s l a l i b . h +** - - - - - - - - - +** +** Prototype function declarations for slalib library. +** +** Last revision: 29 November 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +void slaAddet ( double rm, double dm, double eq, double *rc, double *dc ); + +void slaAfin ( char *string, int *iptr, float *a, int *j ); + +double slaAirmas ( double zd ); + +void slaAltaz ( double ha, double dec, double phi, + double *az, double *azd, double *azdd, + double *el, double *eld, double *eldd, + double *pa, double *pad, double *padd ); + +void slaAmp ( double ra, double da, double date, double eq, + double *rm, double *dm ); + +void slaAmpqk ( double ra, double da, double amprms[21], + double *rm, double *dm ); + +void slaAop ( double rap, double dap, double date, double dut, + double elongm, double phim, double hm, double xp, + double yp, double tdk, double pmb, double rh, + double wl, double tlr, + double *aob, double *zob, double *hob, + double *dob, double *rob ); + +void slaAoppa ( double date, double dut, double elongm, double phim, + double hm, double xp, double yp, double tdk, double pmb, + double rh, double wl, double tlr, double aoprms[14] ); + +void slaAoppat ( double date, double aoprms[14] ); + +void slaAopqk ( double rap, double dap, double aoprms[14], + double *aob, double *zob, double *hob, + double *dob, double *rob ); + +void slaAtmdsp ( double tdk, double pmb, double rh, double wl1, + double a1, double b1, double wl2, double *a2, double *b2 ); + +void slaAv2m ( float axvec[3], float rmat[3][3] ); + +float slaBear ( float a1, float b1, float a2, float b2 ); + +void slaCaf2r ( int ideg, int iamin, float asec, float *rad, int *j ); + +void slaCaldj ( int iy, int im, int id, double *djm, int *j ); + +void slaCalyd ( int iy, int im, int id, int *ny, int *nd, int *j ); + +void slaCc2s ( float v[3], float *a, float *b ); + +void slaCc62s ( float v[6], float *a, float *b, float *r, + float *ad, float *bd, float *rd ); + +void slaCd2tf ( int ndp, float days, char *sign, int ihmsf[4] ); + +void slaCldj ( int iy, int im, int id, double *djm, int *j ); + +void slaClyd ( int iy, int im, int id, int *ny, int *nd, int *jstat ); + +void slaCr2af ( int ndp, float angle, char *sign, int idmsf[4] ); + +void slaCr2tf ( int ndp, float angle, char *sign, int ihmsf[4] ); + +void slaCs2c ( float a, float b, float v[3] ); + +void slaCs2c6 ( float a, float b, float r, float ad, + float bd, float rd, float v[6] ); + +void slaCtf2d ( int ihour, int imin, float sec, float *days, int *j ); + +void slaCtf2r ( int ihour, int imin, float sec, float *rad, int *j ); + +void slaDaf2r ( int ideg, int iamin, double asec, double *rad, int *j ); + +void slaDafin ( char *string, int *iptr, double *a, int *j ); + +double slaDat ( double dju ); + +void slaDav2m ( double axvec[3], double rmat[3][3] ); + +double slaDbear ( double a1, double b1, double a2, double b2 ); + +void slaDbjin ( char *string, int *nstrt, + double *dreslt, int *jf1, int *jf2 ); + +void slaDc62s ( double v[6], double *a, double *b, double *r, + double *ad, double *bd, double *rd ); + +void slaDcc2s ( double v[3], double *a, double *b ); + +void slaDcmpf ( double coeffs[6], double *xz, double *yz, double *xs, + double *ys, double *perp, double *orient ); + +void slaDcs2c ( double a, double b, double v[3] ); + +void slaDd2tf ( int ndp, double days, char *sign, int ihmsf[4] ); + +void slaDe2h ( double ha, double dec, double phi, + double *az, double *el ); + +void slaDeuler ( char *order, double phi, double theta, double psi, + double rmat[3][3] ); + +void slaDfltin ( char *string, int *nstrt, double *dreslt, int *jflag ); + +void slaDh2e ( double az, double el, double phi, double *ha, double *dec); + +void slaDimxv ( double dm[3][3], double va[3], double vb[3] ); + +void slaDjcal ( int ndp, double djm, int iymdf[4], int *j ); + +void slaDjcl ( double djm, int *iy, int *im, int *id, double *fd, int *j ); + +void slaDm2av ( double rmat[3][3], double axvec[3] ); + +void slaDmat ( int n, double *a, double *y, double *d, int *jf, int *iw ); + +void slaDmoon ( double date, double pv[6] ); + +void slaDmxm ( double a[3][3], double b[3][3], double c[3][3] ); + +void slaDmxv ( double dm[3][3], double va[3], double vb[3] ); + +void slaDr2af ( int ndp, double angle, char *sign, int idmsf[4] ); + +void slaDr2tf ( int ndp, double angle, char *sign, int ihmsf[4] ); + +double slaDrange ( double angle ); + +double slaDranrm ( double angle ); + +void slaDs2c6 ( double a, double b, double r, double ad, double bd, + double rd, double v[6] ); + +void slaDs2tp ( double ra, double dec, double raz, double decz, + double *xi, double *eta, int *j ); + +double slaDsep ( double a1, double b1, double a2, double b2 ); + +double slaDt ( double epoch ); + +void slaDtf2d ( int ihour, int imin, double sec, double *days, int *j ); + +void slaDtf2r ( int ihour, int imin, double sec, double *rad, int *j ); + +void slaDtp2s ( double xi, double eta, double raz, double decz, + double *ra, double *dec ); + +void slaDtp2v ( double xi, double eta, double v0[3], double v[3] ); + +void slaDtps2c ( double xi, double eta, double ra, double dec, + double *raz1, double *decz1, + double *raz2, double *decz2, int *n ); + +void slaDtpv2c ( double xi, double eta, double v[3], + double v01[3], double v02[3], int *n ); + +double slaDtt ( double dju ); + +void slaDv2tp ( double v[3], double v0[3], double *xi, double *eta, int *j ); + +double slaDvdv ( double va[3], double vb[3] ); + +void slaDvn ( double v[3], double uv[3], double *vm ); + +void slaDvxv ( double va[3], double vb[3], double vc[3] ); + +void slaE2h ( float ha, float dec, float phi, float *az, float *el ); + +void slaEarth ( int iy, int id, float fd, float posvel[6] ); + +void slaEcleq ( double dl, double db, double date, double *dr, double *dd ); + +void slaEcmat ( double date, double rmat[3][3] ); + +void slaEcor ( float rm, float dm, int iy, int id, float fd, + float *rv, float *tl ); + +void slaEg50 ( double dr, double dd, double *dl, double *db ); + +double slaEpb ( double date ); + +double slaEpb2d ( double epb ); + +double slaEpco ( char k0, char k, double e ); + +double slaEpj ( double date ); + +double slaEpj2d ( double epj ); + +void slaEqecl ( double dr, double dd, double date, double *dl, double *db ); + +double slaEqeqx ( double date ); + +void slaEqgal ( double dr, double dd, double *dl, double *db ); + +void slaEtrms ( double ep, double ev[3] ); + +void slaEuler ( char *order, float phi, float theta, float psi, + float rmat[3][3] ); + +void slaEvp ( double date, double deqx, + double dvb[3], double dpb[3], + double dvh[3], double dph[3] ); + +void slaFitxy ( int itype, int np, double xye[][2], double xym[][2], + double coeffs[6], int *j ); + +void slaFk425 ( double r1950, double d1950, double dr1950, + double dd1950, double p1950, double v1950, + double *r2000, double *d2000, double *dr2000, + double *dd2000, double *p2000, double *v2000 ); + +void slaFk45z ( double r1950, double d1950, double bepoch, + double *r2000, double *d2000 ); + +void slaFk524 ( double r2000, double d2000, double dr2000, + double dd2000, double p2000, double v2000, + double *r1950, double *d1950, double *dr1950, + double *dd1950, double *p1950, double *v1950 ); + +void slaFk54z ( double r2000, double d2000, double bepoch, + double *r1950, double *d1950, + double *dr1950, double *dd1950 ); + +void slaFlotin ( char *string, int *nstrt, float *reslt, int *jflag ); + +void slaGaleq ( double dl, double db, double *dr, double *dd ); + +void slaGalsup ( double dl, double db, double *dsl, double *dsb ); + +void slaGe50 ( double dl, double db, double *dr, double *dd ); + +void slaGeoc ( double p, double h, double *r, double *z ); + +double slaGmst ( double ut1 ); + +double slaGmsta ( double date, double ut1 ); + +void slaH2e ( float az, float el, float phi, float *ha, float *dec ); + +void slaImxv ( float rm[3][3], float va[3], float vb[3] ); + +void slaIntin ( char *string, int *nstrt, long *ireslt, int *jflag ); + +void slaInvf ( double fwds[6], double bkwds[6], int *j ); + +void slaKbj ( int jb, double e, char *k, int *j ); + +void slaM2av ( float rmat[3][3], float axvec[3] ); + +void slaMap ( double rm, double dm, double pr, double pd, + double px, double rv, double eq, double date, + double *ra, double *da ); + +void slaMappa ( double eq, double date, double amprms[21] ); + +void slaMapqk ( double rm, double dm, double pr, double pd, + double px, double rv, double amprms[21], + double *ra, double *da ); + +void slaMapqkz ( double rm, double dm, double amprms[21], + double *ra, double *da ); + +void slaMoon ( int iy, int id, float fd, float posvel[6] ); + +void slaMxm ( float a[3][3], float b[3][3], float c[3][3] ); + +void slaMxv ( float rm[3][3], float va[3], float vb[3] ); + +void slaNut ( double date, double rmatn[3][3] ); + +void slaNutc ( double date, double *dpsi, double *deps, double *eps0 ); + +void slaOap ( char *type, double ob1, double ob2, double date, + double dut, double elongm, double phim, double hm, + double xp, double yp, double tdk, double pmb, + double rh, double wl, double tlr, + double *rap, double *dap ); + +void slaOapqk ( char *type, double ob1, double ob2, double aoprms[14], + double *rap, double *dap ); + +void slaObs ( int n, char *c, char *name, double *w, double *p, double *h ); + +double slaPa ( double ha, double dec, double phi ); + +void slaPcd ( double disco, double *x, double *y ); + +void slaPda2h ( double p, double d, double a, + double *h1, int *j1, double *h2, int *j2 ); + +void slaPdq2h ( double p, double d, double q, + double *h1, int *j1, double *h2, int *j2 ); + +void slaPlanet ( double date, int np, double pv[6], int *j ); + +void slaPm ( double r0, double d0, double pr, double pd, + double px, double rv, double ep0, double ep1, + double *r1, double *d1 ); + +void slaPolmo ( double elongm, double phim, double xp, double yp, + double *elong, double *phi, double *daz ); + +void slaPrebn ( double bep0, double bep1, double rmatp[3][3] ); + +void slaPrec ( double ep0, double ep1, double rmatp[3][3] ); + +void slaPrecl ( double ep0, double ep1, double rmatp[3][3] ); + +void slaPreces ( char sys[3], double ep0, double ep1, + double *ra, double *dc ); + +void slaPrenut ( double epoch, double date, double rmatpn[3][3] ); + +void slaPvobs ( double p, double h, double stl, double pv[6] ); + +void slaPxy ( int np, double xye[][2], double xym[][2], + double coeffs[6], + double xyp[][2], double *xrms, double *yrms, double *rrms ); + +float slaRange ( float angle ); + +float slaRanorm ( float angle ); + +double slaRcc ( double tdb, double ut1, double wl, double u, double v ); + +void slaRdplan ( double date, int np, double elong, double phi, + double *ra, double *dec, double *diam ); + +void slaRefco ( double hm, double tdk, double pmb, double rh, + double wl, double phi, double tlr, double eps, + double *refa, double *refb ); + +void slaRefro ( double zobs, double hm, double tdk, double pmb, + double rh, double wl, double phi, double tlr, double eps, + double *ref ); + +void slaRefv ( double vu[3], double refa, double refb, double vr[3] ); + +void slaRefz ( double zu, double refa, double refb, double *zr ); + +float slaRverot ( float phi, float ra, float da, float st ); + +float slaRvgalc ( float r2000, float d2000 ); + +float slaRvlg ( float r2000, float d2000 ); + +float slaRvlsrd ( float r2000, float d2000 ); + +float slaRvlsrk ( float r2000, float d2000 ); + +void slaS2tp ( float ra, float dec, float raz, float decz, + float *xi, float *eta, int *j ); + +float slaSep ( float a1, float b1, float a2, float b2 ); + +void slaSmat ( int n, float *a, float *y, float *d, int *jf, int *iw ); + +void slaSubet ( double rc, double dc, double eq, + double *rm, double *dm ); + +void slaSupgal ( double dsl, double dsb, double *dl, double *db ); + +void slaSvd ( int m, int n, int mp, int np, + double *a, double *w, double *v, double *work, + int *jstat ); + +void slaSvdcov ( int n, int np, int nc, + double *w, double *v, double *work, double *cvm ); + +void slaSvdsol ( int m, int n, int mp, int np, + double *b, double *u, double *w, double *v, + double *work, double *x ); + +void slaTp2s ( float xi, float eta, float raz, float decz, + float *ra, float *dec ); + +void slaTp2v ( float xi, float eta, float v0[3], float v[3] ); + +void slaTps2c ( float xi, float eta, float ra, float dec, + float *raz1, float *decz1, + float *raz2, float *decz2, int *n ); + +void slaTpv2c ( float xi, float eta, float v[3], + float v01[3], float v02[3], int *n ); + +void slaUnpcd ( double disco, double *x, double *y ); + +void slaV2tp ( float v[3], float v0[3], float *xi, float *eta, int *j ); + +float slaVdv ( float va[3], float vb[3] ); + +void slaVn ( float v[3], float uv[3], float *vm ); + +void slaVxv ( float va[3], float vb[3], float vc[3] ); + +void slaXy2xy ( double x1, double y1, double coeffs[6], + double *x2, double *y2 ); + +double slaZd ( double ha, double dec, double phi ); + +#endif diff --git a/src/include/slamac.h b/src/include/slamac.h new file mode 100644 index 0000000..6b0fa0e --- /dev/null +++ b/src/include/slamac.h @@ -0,0 +1,100 @@ +#ifndef SLAMACHDEF +#define SLAMACHDEF + +/* +** - - - - - - - - - +** s l a m a c . h +** - - - - - - - - - +** +** Macros used by slalib library. +** +** Last revision: 5 June 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +/* max(A,B) - larger (most +ve) of two numbers (generic) */ +#define gmax(A,B) ((A)>(B)?(A):(B)) + +/* min(A,B) - smaller (least +ve) of two numbers (generic) */ +#define gmin(A,B) ((A)<(B)?(A):(B)) + +/* dint(A) - truncate to nearest whole number towards zero (double) */ +#define dint(A) ((A)<0.0?ceil(A):floor(A)) + +/* aint(A) - truncate to nearest whole number towards zero (float) */ +#define aint(A) ((A)<0.0f?(float)ceil((double)(A)):(float)floor((double)(A))) + +/* dnint(A) - round to nearest whole number (double) */ +#define dnint(A) ((A)<0.0?ceil((A)-0.5):floor((A)+0.5)) + +/* anint(A) - round to nearest whole number (float) */ +#define anint(A) ((float)dnint((double)(A))) + +/* dsign(A,B) - magnitude of A with sign of B (double) */ +#define dsign(A,B) ((B)<0.0?-(A):(A)) + +/* dmod(A,B) - A modulo B (double) */ +#define dmod(A,B) ((B)!=0.0?((A)*(B)>0.0?(A)-(B)*floor((A)/(B))\ + :(A)+(B)*floor(-(A)/(B))):(A)) + +/* logicals */ +#if !defined(FALSE) || ((FALSE)!=0) +#define FALSE 0 +#endif +#if !defined(TRUE) || ((TRUE)!=1) +#define TRUE 1 +#endif + +/* pi */ +#define DPI 3.1415926535897932384626433832795028841971693993751 + +/* 2pi */ +#define D2PI 6.2831853071795864769252867665590057683943387987502 + +/* 1/(2pi) */ +#define D1B2PI 0.15915494309189533576888376337251436203445964574046 + +/* 4pi */ +#define D4PI 12.566370614359172953850573533118011536788677597500 + +/* 1/(4pi) */ +#define D1B4PI 0.079577471545947667884441881686257181017229822870228 + +/* pi^2 */ +#define DPISQ 9.8696044010893586188344909998761511353136994072408 + +/* sqrt(pi) */ +#define DSQRPI 1.7724538509055160272981674833411451827975494561224 + +/* pi/2: 90 degrees in radians */ +#define DPIBY2 1.5707963267948966192313216916397514420985846996876 + +/* pi/180: degrees to radians */ +#define DD2R 0.017453292519943295769236907684886127134428718885417 + +/* 180/pi: radians to degrees */ +#define DR2D 57.295779513082320876798154814105170332405472466564 + +/* pi/(180*3600): arcseconds to radians */ +#define DAS2R 4.8481368110953599358991410235794797595635330237270e-6 + +/* 180*3600/pi : radians to arcseconds */ +#define DR2AS 2.0626480624709635515647335733077861319665970087963e5 + +/* pi/12: hours to radians */ +#define DH2R 0.26179938779914943653855361527329190701643078328126 + +/* 12/pi: radians to hours */ +#define DR2H 3.8197186342054880584532103209403446888270314977709 + +/* pi/(12*3600): seconds of time to radians */ +#define DS2R 7.2722052166430399038487115353692196393452995355905e-5 + +/* 12*3600/pi: radians to seconds of time */ +#define DR2S 1.3750987083139757010431557155385240879777313391975e4 + +/* 15/(2pi): hours to degrees x radians to turns */ +#define D15B2P 2.3873241463784300365332564505877154305168946861068 + +#endif |