aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoseph Hunkeler <jhunkeler@gmail.com>2015-03-05 12:53:09 -0500
committerJoseph Hunkeler <jhunkeler@gmail.com>2015-03-05 12:53:09 -0500
commit832b4b34ff8ce84a13751883c0822c16c152fe48 (patch)
treeedb4d7050c37ade55bc543de80e76e58c4486908 /src
parent8f848043369b49e861942ce132181fed2c53c2d3 (diff)
downloadcalfuse-832b4b34ff8ce84a13751883c0822c16c152fe48.tar.gz
Massive rework
Diffstat (limited to 'src')
-rw-r--r--src/include/calfitsio.h157
-rw-r--r--src/include/calfuse.h536
-rw-r--r--src/include/cfortran.doc2051
-rw-r--r--src/include/cfortran.h2363
-rw-r--r--src/include/cfortran.h.3.92149
-rw-r--r--src/include/compress.h212
-rw-r--r--src/include/config.h.in142
-rw-r--r--src/include/drvrsmem.h178
-rw-r--r--src/include/eval_defs.h147
-rw-r--r--src/include/eval_tab.h37
-rw-r--r--src/include/f77_wrap.h277
-rw-r--r--src/include/fusebuf.h34
-rw-r--r--src/include/group.h65
-rw-r--r--src/include/grparser.h181
-rw-r--r--src/include/imcompress.h56
-rw-r--r--src/include/longnam.h476
-rw-r--r--src/include/pctype.h155
-rw-r--r--src/include/region.h80
-rw-r--r--src/include/ricecomp.h107
-rw-r--r--src/include/sgp4.h62
-rw-r--r--src/include/slalib.h418
-rw-r--r--src/include/slamac.h100
22 files changed, 9983 insertions, 0 deletions
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
generated by cgit (git 2.34.1) at 2025-09-20 06:32:50 -0400