Usenet 1994 October

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume20 / cfortran / part02 < prev next >

Wrap

Text File | 1991-06-26 | 56.7 KB | 1,204 lines

Newsgroups: comp.sources.misc From: Burkhard Burow <burow@cernvax.cern.ch> Subject: v20i067: cfortran - a bridge between C and FORTRAN, Part02/02 Message-ID: <1991Jun25.193417.29440@sparky.IMD.Sterling.COM> X-Md4-Signature: 99448899475aca49f1c8959692bf74a5 Date: Tue, 25 Jun 1991 19:34:17 GMT Approved: kent@sparky.imd.sterling.com Submitted-by: Burkhard Burow <burow@cernvax.cern.ch> Posting-number: Volume 20, Issue 67 Archive-name: cfortran/part02 #! /bin/sh # into a shell via "sh file" or similar. To overwrite existing files, # type "sh file -c". # The tool that generated this appeared in the comp.sources.unix newsgroup; # send mail to comp-sources-unix@uunet.uu.net if you want that tool. # Contents: cfortran.h # Wrapped by kent@sparky on Tue Jun 25 14:25:33 1991 PATH=/bin:/usr/bin:/usr/ucb ; export PATH echo If this archive is complete, you will see the following message: echo ' "shar: End of archive 2 (of 2)."' if test -f 'cfortran.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'cfortran.h'\" else echo shar: Extracting \"'cfortran.h'\" $54924 characters$ sed "s/^X//" >'cfortran.h' <<'END_OF_FILE' X/* cfortran.h */ X/* Burkhard Burow, University of Toronto, 1991. */ X X#ifndef __CFORTRAN_LOADED X#define __CFORTRAN_LOADED 1 X X#if !defined(mips) && !defined(_IBMR2) && !(defined(vms) && defined(VAXC)) X??=error This header file is for the following compilers: X??=error - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...) X??=error - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000 X??=error - VAX VMS CC 3.1 and FORTRAN 5.4. X#else X X#ifdef vms X#include <descrip.h> X#endif X#include <stddef.h> X#include <stdlib.h> X#include <string.h> X X/* Note that for VMS and IBMR2 (without -Dextname), one may wish to change the X defaults for fcallsc and/or ccallsc. */ X X#if defined(mips) || (defined(_IBMR2) && defined(extname)) X#define C_(A) A/**/_ X#define ccallsc(NAME) NAME X#else X#define C_(A) A X#define ccallsc(NAME) CF/**/NAME X#endif X#define fcallsc C_ X#define C_FUNCTION fcallsc X#define FORTRAN_FUNCTION C_ X#define COMMON_BLOCK C_ X/*-------------------------------------------------------------------------*/ X X/* UTILITIES USED WITHIN CFORTRAN */ X X#define MIN(A,B) (A<B?A:B) X#define firstindexlength( A) (sizeof(A) /sizeof(A[0])) X#define secondindexlength(A) (sizeof((A)[0])/sizeof((A)[0][0])) X X/* Convert a vector of C strings into FORTRAN strings. */ Xstatic char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr) X{ int i,j; X/* elem_len includes \0 for C strings. Fortran strings don't have term. \0. X Useful size of string must be the same in both languages. */ Xfor (i=0; i<sizeofcstr/elem_len; i++) { X for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++; X cstr += 1+elem_len-j; X for (; j<elem_len; j++) *fstr++ = ' '; X} Xreturn fstr-sizeofcstr+sizeofcstr/elem_len; X} X X/* Convert a vector of FORTRAN strings into C strings. */ Xstatic char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr) X{ int i,j; X/* elem_len includes \0 for C strings. Fortran strings don't have term. \0. X Useful size of string must be the same in both languages. */ Xcstr += sizeofcstr; Xfstr += sizeofcstr - sizeofcstr/elem_len; Xfor (i=0; i<sizeofcstr/elem_len; i++) { X *--cstr = '\0'; X for (j=1; j<elem_len; j++) *--cstr = *--fstr; X} Xreturn cstr; X} X X/* kill the trailing char t's in string s. */ Xstatic char *kill_trailing(char *s, char t) X{char *e; Xe = s + strlen(s); Xif (e>s) { /* Need this to handle NULL string.*/ X while (e>s && *--e==t); /* Don't follow t's past beginning. */ X e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */ X} Xreturn s; X} X X/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally Xpoints to the terminating '\0' of s, but may actually point to anywhere in s. Xs's new '\0' will be placed at e or earlier in order to remove any trailing t's. XIf e<s string s is left unchanged. */ Xstatic char *kill_trailingn(char *s, char t, char *e) X{ Xif (e==s) *e = '\0'; /* Kill the string makes sense here.*/ Xelse if (e>s) { /* Watch out for neg. length string.*/ X while (e>s && *--e==t); /* Don't follow t's past beginning. */ X e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */ X} Xreturn s; X} X X/* Note the following assumes that any element which has t's to be chopped off, Xdoes indeed fill the entire element. */ Xstatic char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t) X{ int i; Xfor (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */ X kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1); Xreturn cstr; X} X X#ifdef vms Xtypedef struct dsc$descriptor_s fstring; X#define DSC$DESCRIPTOR_A(DIMCT) \ Xstruct { \ X unsigned short dsc$w_length; \ X unsigned char dsc$b_dtype; \ X unsigned char dsc$b_class; \ X char *dsc$a_pointer; \ X char dsc$b_scale; \ X unsigned char dsc$b_digits; \ X struct { \ X unsigned : 3; \ X unsigned dsc$v_fl_binscale : 1; \ X unsigned dsc$v_fl_redim : 1; \ X unsigned dsc$v_fl_column : 1; \ X unsigned dsc$v_fl_coeff : 1; \ X unsigned dsc$v_fl_bounds : 1; \ X } dsc$b_aflags; \ X unsigned char dsc$b_dimct; \ X unsigned long dsc$l_arsize; \ X char *dsc$a_a0; \ X long dsc$l_m [DIMCT]; \ X struct { \ X long dsc$l_l; \ X long dsc$l_u; \ X } dsc$bounds [DIMCT]; \ X} Xtypedef DSC$DESCRIPTOR_A(1) fstringvector; X/*typedef DSC$DESCRIPTOR_A(2) fstringarrarr; X typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/ X#define initfstr(F,C,ELEMNO,ELEMLEN) \ X( (F).dsc$l_arsize= ( (F).dsc$w_length =(ELEMLEN) ) \ X *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO) ), \ X (F).dsc$a_a0 = ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length ,(F)) X X#define F2CSTRVCOPY(C,F) \ X vkill_trailing(f2cstrv(F->dsc$a_pointer,C,F->dsc$w_length+1, \ X F->dsc$l_m[0]*(F->dsc$w_length+1)), \ X F->dsc$w_length+1,F->dsc$l_m[0]*(F->dsc$w_length+1),' ') X#define C2FSTRVCOPY(C,F) c2fstrv(C,F->dsc$a_pointer,F->dsc$w_length+1, \ X F->dsc$l_m[0]*(F->dsc$w_length+1) ) X X#else X#define _NUM_ELEMS -1 X#define _NUM_ELEM_ARG -2 X#define NUM_ELEMS(A) A,_NUM_ELEMS X#define NUM_ELEM_ARG(B) *A/**/B,_NUM_ELEM_ARG X#define TERM_CHARS(A,B) A,B Xstatic int num_elem(char *strv, unsigned elem_len, int term_char, X int num_term_char) X/* elem_len is the number of characters in each element of strv, the FORTRAN Xvector of strings. The last element of the vector must begin with at least Xnum_term_char term_char characters, so that this routine can determine how Xmany elements are in the vector. */ X{ Xunsigned num,i; Xif (num_term_char == _NUM_ELEMS || num_term_char == _NUM_ELEM_ARG) X return term_char; Xif (num_term_char <=0) num_term_char = elem_len; Xfor (num=0; ; num++) { X for (i=0; i<num_term_char && *strv==term_char; i++,strv++); X if (i==num_term_char) break; X else strv += elem_len-i; X} Xreturn num; X} X#endif X/*-------------------------------------------------------------------------*/ X X/* UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS */ X X/* C string TO Fortran Common Block STRing. */ X/* DIM is the number of DIMensions of the array in terms of strings, not X characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */ X#define C2FCBSTR(CSTR,FSTR,DIM) \ X c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \ X sizeof(FSTR)+cfelementsof(FSTR,DIM)) X X/* Fortran Common Block string TO C STRing. */ X#define FCB2CSTR(FSTR,CSTR,DIM) \ X vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR, \ X sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \ X sizeof(FSTR)+cfelementsof(FSTR,DIM)), \ X sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \ X sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ') X X#define cfDEREFERENCE0 X#define cfDEREFERENCE1 * X#define cfDEREFERENCE2 ** X#define cfDEREFERENCE3 *** X#define cfDEREFERENCE4 **** X#define cfDEREFERENCE5 ***** X#define cfelementsof(A,D) (sizeof(A)/sizeof(cfDEREFERENCE/**/D(A))) X X/*-------------------------------------------------------------------------*/ X X/* UTILITIES FOR C TO CALL FORTRAN SUBROUTINES */ X X/* Define lookup tables for how to handle the various types of variables. */ X X#ifdef VAXC /* To avoid %CC-I-PARAMNOTUSED. */ X#pragma nostandard X#endif X X#define VCF(TN,I) V/**/TN(A/**/I,B/**/I) X#define VDOUBLE( A,B) double B = A; X#define VFLOAT( A,B) float B = A; X#define VINT( A,B) int B = (int)A; /* typecast for enum's sake */ X#define VLOGICAL( A,B) int B = A; X#define VLONG( A,B) long B = A; X#define VDOUBLEV( A,B) double *B = A; X#define VFLOATV( A,B) float *B = A; X#define VINTV( A,B) int *B = A; X#define VDOUBLEVV(A,B) double *B = A[0]; X#define VFLOATVV( A,B) float *B = A[0]; X#define VINTVV( A,B) int *B = A[0]; X#define VPDOUBLE( A,B) X#define VPFLOAT( A,B) X#define VPINT( A,B) X#define VPLOGICAL(A,B) X#define VPLONG( A,B) X#define VPVOID( A,B) X#define VPSTRUCT( A,B) X#ifdef vms X#define VSTRING( A,B) static struct {fstring f; unsigned clen;} B = \ X {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0}; X#define VPSTRING( A,B) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL}; X#define VSTRINGV( A,B) static fstringvector B = \ X{sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,0,1,1,1},1,0,NULL,0,{1,0}}; X#define VPSTRINGV(A,B) static fstringvector B = \ X{0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,0,1,1,1},1,0,NULL,0,{1,0}}; X#else X#define VSTRING( A,B) struct {unsigned short clen, flen;} B; X#define VSTRINGV( A,B) struct {char *s; unsigned flen;} B; X#define VPSTRING( A,B) int B; X#define VPSTRINGV(A,B) struct {unsigned short sizeofA, flen;} B; X#endif X X#define ADOUBLE( A,B) &B X#define AFLOAT( A,B) &B X#define AINT( A,B) &B X#define ALOGICAL( A,B) &B X#define ALONG( A,B) &B X#define ADOUBLEV( A,B) B X#define AFLOATV( A,B) B X#define AINTV( A,B) B X#define ADOUBLEVV(A,B) B X#define AFLOATVV( A,B) B X#define AINTVV( A,B) B X#define APDOUBLE( A,B) &A X#define APFLOAT(A,B) &A X#define APINT( A,B) (int *) & A /* typecast for enum's sake */ X#define APLOGICAL(A,B) &A X#define APLONG( A,B) &A X#define APVOID( A,B) (void *) A X#define APSTRUCT( A,B) (void *)&A X#define ASTRING( A,B) CSTRING(A,B,sizeof(A)) X#define APSTRING( A,B) CPSTRING(A,B,sizeof(A)) X#ifdef vms X#define ASTRINGV( A,B) (initfstr(B,malloc(sizeof(A)-firstindexlength(A)), \ X firstindexlength(A),secondindexlength(A)-1), \ X c2fstrv(A[0],B.dsc$a_pointer,secondindexlength(A),sizeof(A)),&B) X#define APSTRINGV(A,B) (initfstr(B,A[0],firstindexlength(A), \ X secondindexlength(A)-1), \ X c2fstrv(A[0],A[0],secondindexlength(A),sizeof(A)), &B) X#else X#define ASTRINGV( A,B) (B.s=malloc(sizeof(A)-firstindexlength(A)), \ X c2fstrv(A[0],B.s,(B.flen=secondindexlength(A)-1)+1,sizeof(A))) X#define APSTRINGV(A,B) c2fstrv(A[0],A[0],(B.flen=secondindexlength(A)-1)+1, \ X B.sizeofA=sizeof(A)) X#endif X X#define JCF(TN,I) J/**/TN(A/**/I,B/**/I) X#define JDOUBLE( A,B) X#define JFLOAT( A,B) X#define JINT( A,B) X#define JLOGICAL( A,B) X#define JLONG( A,B) X#define JDOUBLEV( A,B) X#define JFLOATV( A,B) X#define JINTV( A,B) X#define JDOUBLEVV(A,B) X#define JFLOATVV( A,B) X#define JINTVV( A,B) X#define JPDOUBLE( A,B) X#define JPFLOAT( A,B) X#define JPINT( A,B) X#define JPLOGICAL(A,B) X#define JPLONG( A,B) X#define JPVOID( A,B) X#define JPSTRUCT( A,B) X#ifdef vms X#define JSTRING( A,B) X#define JPSTRING( A,B) X#else X#define JSTRING( A,B) ,B.flen X#define JPSTRING( A,B) ,B X#endif X#define JSTRINGV JSTRING X#define JPSTRINGV JSTRING X X#define WCF(TN,I) W/**/TN(A/**/I,B/**/I) X#define WDOUBLE( A,B) X#define WFLOAT( A,B) X#define WINT( A,B) X#define WLOGICAL( A,B) X#define WLONG( A,B) X#define WDOUBLEV( A,B) X#define WFLOATV( A,B) X#define WINTV( A,B) X#define WDOUBLEVV(A,B) X#define WFLOATVV( A,B) X#define WINTVV( A,B) X#define WPDOUBLE( A,B) X#define WPFLOAT( A,B) X#define WPINT( A,B) X#define WPLOGICAL(A,B) X#define WPLONG( A,B) X#define WPVOID( A,B) X#define WPSTRUCT( A,B) X#define WSTRING( A,B) (A[B.clen]!='\0'?A[B.clen]='\0':0); /* A may be "const"*/ X#define WPSTRING( A,B) kill_trailing(A,' '); X#ifdef vms X#define WSTRINGV( A,B) free(B.dsc$a_pointer); X#define WPSTRINGV(A,B) \ X vkill_trailing(f2cstrv((char*)A, (char*)A, \ X B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]), \ X B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' '); X#else X#define WSTRINGV( A,B) free(B.s); X#define WPSTRINGV(A,B) vkill_trailing( \ X f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' '); X#endif X X#define NDOUBLE double * X#define NFLOAT float * X#define NINT int * X#define NLOGICAL int * X#define NLONG long * X#define NDOUBLEV double * X#define NFLOATV float * X#define NINTV int * X#define NFLOATVV float * X#define NINTVV int * X#define NPDOUBLE double * X#define NPFLOAT float * X#define NPINT int * X#define NPLOGICAL int * X#define NPLONG long * X#define NPVOID void * X#define NPSTRUCT void * X#ifdef vms X#define NSTRING fstring * X#define NSTRINGV fstringvector * X#else X#define NSTRING char * X#define NSTRINGV char * X#endif X#define NPSTRING NSTRING X#define NPSTRINGV NSTRINGV X X#ifdef VAXC /* Have avoid %CC-I-PARAMNOTUSED. */ X#pragma standard X#endif X X#define CCALLSFSUB0(NAME) {C_(NAME)();} X X#define CCALLSFSUB1(NAME,T1,A1) \ X{V/**/T1(A1,B1) C_(NAME)(A/**/T1(A1,B1) J/**/T1(A1,B1)); W/**/T1(A1,B1)} X X#define CCALLSFSUB2(NAME,T1,T2,A1,A2) \ X{V/**/T1(A1,B1) V/**/T2(A2,B2) \ X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2) J/**/T1(A1,B1) J/**/T2(A2,B2)); \ X W/**/T1(A1,B1) W/**/T2(A2,B2)} X X#define CCALLSFSUB3(NAME,T1,T2,T3,A1,A2,A3) \ X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) \ X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3) \ X J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3)); \ X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3)} X X#define CCALLSFSUB4(NAME,T1,T2,T3,T4,A1,A2,A3,A4) \ X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) \ X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4) \ X J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4)); \ X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4)} X X#define CCALLSFSUB5(NAME,T1,T2,T3,T4,T5,A1,A2,A3,A4,A5) \ X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5) \ X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4), \ X A/**/T5(A5,B5) J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) \ X J/**/T4(A4,B4) J/**/T5(A5,B5)); \ X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5)} X X#define CCALLSFSUB6(NAME,T1,T2,T3,T4,T5,T6,A1,A2,A3,A4,A5,A6) \ X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) \ X V/**/T5(A5,B5) V/**/T6(A6,B6) \ X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4), \ X A/**/T5(A5,B5),A/**/T6(A6,B6) J/**/T1(A1,B1) J/**/T2(A2,B2) \ X J/**/T3(A3,B3) J/**/T4(A4,B4) J/**/T5(A5,B5) J/**/T6(A6,B6)); \ X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) \ X W/**/T5(A5,B5) W/**/T6(A6,B6)} X X#define CCALLSFSUB7(NAME,T1,T2,T3,T4,T5,T6,T7,A1,A2,A3,A4,A5,A6,A7) \ X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) \ X V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7) \ X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4), \ X A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7) \ X J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4) \ X J/**/T5(A5,B5) J/**/T6(A6,B6) J/**/T7(A7,B7)); \ X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) \ X W/**/T5(A5,B5) W/**/T6(A6,B6) W/**/T7(A7,B7)} X X#define CCALLSFSUB8(NAME,T1,T2,T3,T4,T5,T6,T7,T8,A1,A2,A3,A4,A5,A6,A7,A8) \ X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) \ X V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) \ X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4), \ X A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8) \ X J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4) \ X J/**/T5(A5,B5) J/**/T6(A6,B6) J/**/T7(A7,B7) J/**/T8(A8,B8)); \ X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) \ X W/**/T5(A5,B5) W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8)} X X#define CCALLSFSUB9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\ X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) \ X V/**/T5(A5,B5) V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9) \ X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4), \ X A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8), \ X A/**/T9(A9,B9) J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) \ X J/**/T4(A4,B4) J/**/T5(A5,B5) J/**/T6(A6,B6) J/**/T7(A7,B7) \ X J/**/T8(A8,B8) J/**/T9(A9,B9)); \ X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) \ X W/**/T5(A5,B5) W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9)} X X#define CCALLSFSUB10(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA, \ X A1,A2,A3,A4,A5,A6,A7,A8,A9,AA) \ X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5) \ X V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9) V/**/TA(AA,BA) \ X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4), \ X A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8), \ X A/**/T9(A9,B9),A/**/TA(AA,BA) J/**/T1(A1,B1) J/**/T2(A2,B2) \ X J/**/T3(A3,B3) J/**/T4(A4,B4) J/**/T5(A5,B5) J/**/T6(A6,B6) \ X J/**/T7(A7,B7) J/**/T8(A8,B8) J/**/T9(A9,B9) J/**/TA(AA,BA)); \ X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5) \ X W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9) W/**/TA(AA,BA) } X X#define CCALLSFSUB11(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB, \ X A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB) \ X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5) \ X V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9) V/**/TA(AA,BA) \ X V/**/TB(AB,BB) \ X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4), \ X A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8), \ X A/**/T9(A9,B9),A/**/TA(AA,BA),A/**/TB(AB,BB) J/**/T1(A1,B1) \ X J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4) J/**/T5(A5,B5) \ X J/**/T6(A6,B6) J/**/T7(A7,B7) J/**/T8(A8,B8) J/**/T9(A9,B9) \ X J/**/TA(AA,BA) J/**/TB(AB,BB)); \ X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5) \ X W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9) W/**/TA(AA,BA) \ X W/**/TB(AB,BB) } X X#define CCALLSFSUB16(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG, \ X A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG) \ X{V/**/T1(A1,B1) V/**/T2(A2,B2) V/**/T3(A3,B3) V/**/T4(A4,B4) V/**/T5(A5,B5) \ X V/**/T6(A6,B6) V/**/T7(A7,B7) V/**/T8(A8,B8) V/**/T9(A9,B9) V/**/TA(AA,BA) \ X V/**/TB(AB,BB) V/**/TC(AC,BC) V/**/TD(AD,BD) V/**/TE(AE,BE) V/**/TF(AF,BF) \ X V/**/TG(AG,BG) \ X C_(NAME)(A/**/T1(A1,B1),A/**/T2(A2,B2),A/**/T3(A3,B3),A/**/T4(A4,B4), \ X A/**/T5(A5,B5),A/**/T6(A6,B6),A/**/T7(A7,B7),A/**/T8(A8,B8), \ X A/**/T9(A9,B9),A/**/TA(AA,BA),A/**/TB(AB,BB),A/**/TC(AC,BC), \ X A/**/TD(AD,BD),A/**/TE(AE,BE),A/**/TF(AF,BF),A/**/TG(AG,BG) \ X J/**/T1(A1,B1) J/**/T2(A2,B2) J/**/T3(A3,B3) J/**/T4(A4,B4) \ X J/**/T5(A5,B5) J/**/T6(A6,B6) J/**/T7(A7,B7) J/**/T8(A8,B8) \ X J/**/T9(A9,B9) J/**/TA(AA,BA) J/**/TB(AB,BB) J/**/TC(AC,BC) \ X J/**/TD(AD,BD) J/**/TE(AE,BE) J/**/TF(AF,BF) J/**/TG(AG,BG)); \ X W/**/T1(A1,B1) W/**/T2(A2,B2) W/**/T3(A3,B3) W/**/T4(A4,B4) W/**/T5(A5,B5) \ X W/**/T6(A6,B6) W/**/T7(A7,B7) W/**/T8(A8,B8) W/**/T9(A9,B9) W/**/TA(AA,BA) \ X W/**/TB(AB,BB) W/**/TC(AC,BC) W/**/TD(AD,BD) W/**/TE(AE,BE) W/**/TF(AF,BF) \ X W/**/TG(AG,BG) } X X#define PROTOCCALLSFSUB0(NAME) void C_(NAME)(); X#define PROTOCCALLSFSUB1(NAME,T1) void C_(NAME)(N/**/T1, ...); X#define PROTOCCALLSFSUB2(NAME,T1,T2) void C_(NAME)(N/**/T1,N/**/T2, ...); X#define PROTOCCALLSFSUB3(NAME,T1,T2,T3) void C_(NAME)(N/**/T1,N/**/T2,N/**/T3, \ X ...); X#define PROTOCCALLSFSUB4(NAME,T1,T2,T3,T4) \ X void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4, ...); X#define PROTOCCALLSFSUB5(NAME,T1,T2,T3,T4,T5) \ X void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5, ...); X#define PROTOCCALLSFSUB6(NAME,T1,T2,T3,T4,T5,T6) \ X void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5, \ X N/**/T6, ...); X#define PROTOCCALLSFSUB7(NAME,T1,T2,T3,T4,T5,T6,T7) \ X void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5, \ X N/**/T6,N/**/T7, ...); X#define PROTOCCALLSFSUB8(NAME,T1,T2,T3,T4,T5,T6,T7,T8) \ X void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5, \ X N/**/T6,N/**/T7,N/**/T8, ...); X#define PROTOCCALLSFSUB9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ X void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5, \ X N/**/T6,N/**/T7,N/**/T8,N/**/T9, ...); X#define PROTOCCALLSFSUB10(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \ X void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5, \ X N/**/T6,N/**/T7,N/**/T8,N/**/T9,N/**/TA, ...); X#define PROTOCCALLSFSUB11(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \ X void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5, \ X N/**/T6,N/**/T7,N/**/T8,N/**/T9,N/**/TA, \ X N/**/TB, ...); X#define PROTOCCALLSFSUB16(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG)\ X void C_(NAME)(N/**/T1,N/**/T2,N/**/T3,N/**/T4,N/**/T5, \ X N/**/T6,N/**/T7,N/**/T8,N/**/T9,N/**/TA, \ X N/**/TB,N/**/TC,N/**/TD,N/**/TE,N/**/TF, \ X N/**/TG, ...); X X/*-------------------------------------------------------------------------*/ X X/* UTILITIES FOR C TO CALL FORTRAN FUNCTIONS */ X X/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN X function is called. Therefore, especially for creator's of C header files X for large FORTRAN libraries which include many functions, to reduce X compile time and object code size, it may be desirable to create X preprocessor directives to allow users to create code for only those X functions which they use. */ X X/* The following defines the maximum length string that a function can return. X Of course it may be undefine-d and re-define-d before individual X PROTOCCALLSFFUNn(..) as required. */ X#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE X X/* The following defines a character used by CFORTRAN to flag the end of a X string coming out of a FORTRAN routine. */ X#define CFORTRAN_NON_CHAR 0x7F X X/* Define lookup tables for how to handle the various types of variables. X Tables used by for value returnde by - function: U,E,G,X X - arguments: U,B,D,W X Note that W... tables are from above. */ X#ifdef VAXC /* To avoid %CC-I-PARAMNOTUSED. */ X#pragma nostandard X#endif X X#define UDOUBLE double X#define UFLOAT float X#define UINT int X#define ULOGICAL int X#define ULONG long X#define UFLOATV float * X#define UINTV int * X#define UDOUBLEVV double * X#define UFLOATVV float * X#define UINTVV int * X#define UPDOUBLE double * X#define UPFLOAT float * X#define UPINT int * X#define UPLOGICAL int * X#define UPLONG long * X#define UPVOID void * X#define UPSTRUCT void * X#define UVOID void * /*Needed for FORTRAN calls to C subroutines. */ X#define USTRING char * X#define USTRINGV char * X#define UPSTRING char * X#define UPSTRINGV char * X X#define EDOUBLE double A0; X#define EFLOAT float A0; X#define EINT int A0; X#define ELOGICAL int A0; X#define ELONG long A0; X#ifdef vms X#define ESTRING static char AA0[MAX_LEN_FORTRAN_FUNCTION_STRING+1]; \ X static fstring A0 = \ X {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\ X memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\ X *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0'; X#else X#define ESTRING static char A0[MAX_LEN_FORTRAN_FUNCTION_STRING+1]; \ X memset(A0, CFORTRAN_NON_CHAR, \ X MAX_LEN_FORTRAN_FUNCTION_STRING); \ X *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0'; X#endif X/* ESTRING must use static char. array which is guaranteed to exist after X function returns. */ X X/* N.B.i) The diff. for 0 (Zero) and >=1 arguments. X ii)That the folowing create a single unmatched '(' bracket, which X must of course be matched in the call. X iii)Commas must be handled very carefully */ X#define GZDOUBLE( B) A0=C_(B)( X#define GZFLOAT( B) A0=C_(B)( X#define GZINT( B) A0=C_(B)( X#define GZLOGICAL( B) A0=C_(B)( X#define GZLONG( B) A0=C_(B)( X#ifdef vms X#define GZSTRING( B) B(&A0 X#else X#define GZSTRING( B) C_(B)(A0,MAX_LEN_FORTRAN_FUNCTION_STRING X#endif X X#define GDOUBLE( B) A0=C_(B)( X#define GFLOAT( B) A0=C_(B)( X#define GINT( B) A0=C_(B)( X#define GLOGICAL( B) A0=C_(B)( X#define GLONG( B) A0=C_(B)( X#define GSTRING( B) GZSTRING(B), X X#define BDOUBLE( A) (double) A X#define BFLOAT( A) (float) A X#define BINT( A) (int) A /* typecast for enum's sake */ X#define BLOGICAL( A) (int) A X#define BLONG( A) (long) A X#define BSTRING( A) (char *) A X#define BFLOATV( A) A X#define BINTV( A) A X#define BSTRINGV( A) (char *) A X#define BFLOATVV( A) (A)[0] X#define BINTVV( A) (A)[0] X#define BPDOUBLE( A) &A X#define BPFLOAT( A) &A X#define BPINT( A) &A /*no longer typecast for enum*/ X#define BPLOGICAL( A) &A X#define BPLONG( A) &A X#define BPSTRING( A) (char *) A X#define BPSTRINGV( A) (char *) A X#define BPVOID( A) (void *) A X#define BPSTRUCT( A) (void *) &A X X#define SDOUBLE( A) X#define SFLOAT( A) X#define SINT( A) X#define SLOGICAL( A) X#define SLONG( A) X#define SSTRING( A) ,sizeof(A) X#define SFLOATV( A) X#define SINTV( A) X#define SSTRINGV( A) ,( (unsigned)0xFFFF*firstindexlength(A) \ X +secondindexlength(A)) X#define SFLOATVV( A) X#define SINTVV( A) X#define SPDOUBLE( A) X#define SPFLOAT( A) X#define SPINT( A) X#define SPLOGICAL( A) X#define SPLONG( A) X#define SPSTRING( A) ,sizeof(A) X#define SPSTRINGV SSTRINGV X#define SPVOID( A) X#define SPSTRUCT( A) X X#define HDOUBLE( A) X#define HFLOAT( A) X#define HINT( A) X#define HLOGICAL( A) X#define HLONG( A) X#define HSTRING( A) ,unsigned A X#define HFLOATV( A) X#define HINTV( A) X#define HSTRINGV( A) ,unsigned A X#define HFLOATVV( A) X#define HINTVV( A) X#define HPDOUBLE( A) X#define HPFLOAT( A) X#define HPINT( A) X#define HPLOGICAL( A) X#define HPLONG( A) X#define HPSTRING( A) ,unsigned A X#define HPSTRINGV( A) ,unsigned A X#define HPVOID( A) X#define HPSTRUCT( A) X X#define CCF(TN,I) C/**/TN(A/**/I,B/**/I,C/**/I) X#define CDOUBLE( A,B,C) &A X#define CFLOAT( A,B,C) &A X#define CINT( A,B,C) &A X#define CLOGICAL( A,B,C) &A X#define CLONG( A,B,C) &A X#define CFLOATV( A,B,C) A X#define CINTV( A,B,C) A X#define CFLOATVV( A,B,C) A X#define CINTVV( A,B,C) A X#define CPDOUBLE( A,B,C) A X#define CPFLOAT( A,B,C) A X#define CPINT( A,B,C) A /* typecast for enum's sake */ X#define CPLOGICAL(A,B,C) A X#define CPLONG( A,B,C) A X#define CPVOID( A,B,C) A X#define CPSTRUCT( A,B,C) A X#ifdef vms X#define CSTRING( A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A, \ X C==sizeof(char*)||C==B.clen+1?B.f.dsc$w_length=B.clen,&B.f:\ X (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0',&B.f)) X#define CSTRINGV( A,B,C) ( \ X initfstr(B, malloc((C/0xFFFF)*(C%0xFFFF-1)), C/0xFFFF, C%0xFFFF-1), \ X c2fstrv(A,B.dsc$a_pointer,C%0xFFFF,(C/0xFFFF)*(C%0xFFFF)) ,&B) X#define CPSTRING( A,B,C) (B.dsc$w_length=strlen(A),B.dsc$a_pointer=A, \ X C==sizeof(char*)?&B:(memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1),\ X A[B.dsc$w_length=C-1]='\0',&B)) X#define CPSTRINGV(A,B,C) (initfstr(B, A, C/0xFFFF, C%0xFFFF-1), \ X c2fstrv(A,A,C%0xFFFF,(C/0xFFFF)*(C%0xFFFF)) ,&B) X#else X#define CSTRING( A,B,C) (B.clen=strlen(A), \ X C==sizeof(char*)||C==B.clen+1?B.flen=B.clen,(A): \ X (memset((A)+B.clen,' ',C-B.clen-1),A[B.flen=C-1]='\0',(A))) X#define CSTRINGV( A,B,C) (B.s=malloc((C/0xFFFF)*(C%0xFFFF-1)), \ X c2fstrv(A,B.s,(B.flen=C%0xFFFF-1)+1,(C/0xFFFF)*(C%0xFFFF))) X#define CPSTRING( A,B,C) (B=strlen(A), C==sizeof(char*)?(A): \ X (memset((A)+B,' ',C-B-1),A[B=C-1]='\0',(A))) X#define CPSTRINGV(A,B,C) c2fstrv(A,A,(B.flen=C%0xFFFF-1)+1, \ X B.sizeofA=(C/0xFFFF)*(C%0xFFFF)) X#endif X X#define XDOUBLE return A0; X#define XFLOAT return A0; X#define XINT return A0; X#define XLOGICAL return A0; X#define XLONG return A0; X#ifdef vms X#define XSTRING return kill_trailing( \ X kill_trailing(AA0,CFORTRAN_NON_CHAR),' '); X#else X#define XSTRING return kill_trailing( \ X kill_trailing( A0,CFORTRAN_NON_CHAR),' '); X#endif X X#ifdef VAXC /* Have avoided %CC-I-PARAMNOTUSED. */ X#pragma standard X#endif X X#define CFFUN(NAME) __cf__/**/NAME X X#define CCALLSFFUN0(NAME) CFFUN(NAME)() X X#define CCALLSFFUN1(NAME,T1,A1) CFFUN(NAME)(B/**/T1(A1) S/**/T1(A1)) X X#define CCALLSFFUN2(NAME,T1,T2,A1,A2) CFFUN(NAME)(B/**/T1(A1),B/**/T2(A2) \ X S/**/T1(A1) S/**/T2(A2)) X X#define CCALLSFFUN3(NAME,T1,T2,T3,A1,A2,A3) \ XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3) \ X S/**/T1(A1) S/**/T2(A2) S/**/T3(A3)) X X#define CCALLSFFUN4(NAME,T1,T2,T3,T4,A1,A2,A3,A4) \ XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4) \ X S/**/T1(A1) S/**/T2(A2) S/**/T3(A3) S/**/T4(A4)) X X#define CCALLSFFUN5(NAME,T1,T2,T3,T4,T5,A1,A2,A3,A4,A5) \ XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5) \ X S/**/T1(A1) S/**/T2(A2) S/**/T3(A3) S/**/T4(A4) S/**/T5(A5)) X X#define CCALLSFFUN6(NAME,T1,T2,T3,T4,T5,T6,A1,A2,A3,A4,A5,A6) \ XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5) \ X B/**/T6(A6) \ XS/**/T1(A1) S/**/T2(A2) S/**/T3(A3) S/**/T4(A4) S/**/T5(A5) S/**/T6(A6)) X X#define CCALLSFFUN7(NAME,T1,T2,T3,T4,T5,T6,T7,A1,A2,A3,A4,A5,A6,A7) \ XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5) \ X B/**/T6(A6),B/**/T7(A7) S/**/T1(A1) S/**/T2(A2) S/**/T3(A3) \ X S/**/T4(A4) S/**/T5(A5) S/**/T6(A6) S/**/T7(A7)) X X#define CCALLSFFUN8(NAME,T1,T2,T3,T4,T5,T6,T7,T8,A1,A2,A3,A4,A5,A6,A7,A8) \ XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5) \ X B/**/T6(A6),B/**/T7(A7),B/**/T8(A8) S/**/T1(A1) S/**/T2(A2) \ X S/**/T3(A3) S/**/T4(A4) S/**/T5(A5) S/**/T6(A6) S/**/T7(A7) \ X S/**/T8(A8)) X X#define CCALLSFFUN9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\ XCFFUN(NAME)(B/**/T1(A1),B/**/T2(A2),B/**/T3(A3),B/**/T4(A4),B/**/T5(A5) \ X B/**/T6(A6),B/**/T7(A7),B/**/T8(A8),B/**/T9(A9) S/**/T1(A1) \ X S/**/T2(A2) S/**/T3(A3) S/**/T4(A4) S/**/T5(A5) S/**/T6(A6) \ X S/**/T7(A7) S/**/T8(A8) S/**/T9(A9)) X X/* N.B. Create a separate function instead of using (call function, function Xvalue here) because in order to create the variables needed for the input Xarg.'s which may be const.'s one has to do the creation within {}, but these Xcan never be placed within ()'s. Therefore one must create wrapper functions. Xgcc, on the other hand may be able to avoid the wrapper functions. */ X X#define PROTOCCALLSFFUN0(F,NAME) \ XU/**/F NAME(); /* This is needed to correctly handle the value returned \ XN.B. Can only have prototype arg.'s with difficulty, a la G... table since \ XFORTRAN functions returning strings have extra arg.'s. Don't bother, since \ Xthis only causes a compiler warning to come up when one uses FCALLSCFUNn and \ XCCALLSFFUNn for the same function in the same source code. Something done by \ Xthe experts in tests only.*/ \ Xstatic U/**/F CFFUN(NAME)() {E/**/F GZ/**/F(NAME)); X/**/F} X X#define PROTOCCALLSFFUN1(F,NAME,T1) \ XU/**/F C_(NAME)(); \ Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1 H/**/T1(C1)) \ X{VCF(T1,1) E/**/F G/**/F(NAME)CCF(T1,1) JCF(T1,1)); WCF(T1,1) X/**/F} X X#define PROTOCCALLSFFUN2(F,NAME,T1,T2) \ XU/**/F C_(NAME)(); \ Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2 H/**/T1(C1) H/**/T2(C2)) \ X{VCF(T1,1) VCF(T2,2) E/**/F G/**/F(NAME)CCF(T1,1),CCF(T2,2) \ X JCF(T1,1) JCF(T2,2)); WCF(T1,1) WCF(T2,2) X/**/F} X X#define PROTOCCALLSFFUN3(F,NAME,T1,T2,T3) \ XU/**/F C_(NAME)(); \ Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3 \ X H/**/T1(C1) H/**/T2(C2) H/**/T3(C3)) \ X{VCF(T1,1) VCF(T2,2) VCF(T3,3) E/**/F \ X G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3) JCF(T1,1) JCF(T2,2) JCF(T3,3)); \ X WCF(T1,1) WCF(T2,2) WCF(T3,3) X/**/F} X X#define PROTOCCALLSFFUN4(F,NAME,T1,T2,T3,T4) \ XU/**/F C_(NAME)(); \ Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4 \ X H/**/T1(C1) H/**/T2(C2) H/**/T3(C3) H/**/T4(C4)) \ X{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) E/**/F \ X G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4) JCF(T1,1) JCF(T2,2) \ X JCF(T3,3) JCF(T4,4)); WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) X/**/F} X X#define PROTOCCALLSFFUN5(F,NAME,T1,T2,T3,T4,T5) \ XU/**/F C_(NAME)(); \ Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4, \ X U/**/T5 A5 H/**/T1(C1) H/**/T2(C2) H/**/T3(C3) H/**/T4(C4) H/**/T5(C5)) \ X{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) E/**/F \ X G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5) \ X JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5)); \ X WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) X/**/F} X X#define PROTOCCALLSFFUN6(F,NAME,T1,T2,T3,T4,T5,T6) \ XU/**/F C_(NAME)(); \ Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4, \ X U/**/T5 A5,U/**/T6 A6 H/**/T1(C1) H/**/T2(C2) \ X H/**/T3(C3) H/**/T4(C4) H/**/T5(C5) H/**/T6(C6)) \ X{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) VCF(T6,6) E/**/F \ X G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5),CCF(T6,6) \ X JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6)); \ X WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) WCF(T6,6) X/**/F} X X#define PROTOCCALLSFFUN7(F,NAME,T1,T2,T3,T4,T5,T6,T7) \ XU/**/F C_(NAME)(); \ Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4, \ X U/**/T5 A5,U/**/T6 A6,U/**/T7 A7 H/**/T1(C1) \ X H/**/T2(C2) H/**/T3(C3) H/**/T4(C4) H/**/T5(C5) H/**/T6(C6) H/**/T7(C7)) \ X{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) VCF(T6,6) VCF(T7,7) E/**/F \ X G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5),CCF(T6,6), \ X CCF(T7,7) \ X JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6) JCF(T7,7)); \ X WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) WCF(T6,6) WCF(T7,7) X/**/F} X X#define PROTOCCALLSFFUN8(F,NAME,T1,T2,T3,T4,T5,T6,T7,T8) \ XU/**/F C_(NAME)(); \ Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4, \ X U/**/T5 A5,U/**/T6 A6,U/**/T7 A7,U/**/T8 A8 H/**/T1(C1) H/**/T2(C2) \ X H/**/T3(C3) H/**/T4(C4) H/**/T5(C5) H/**/T6(C6) H/**/T7(C7) H/**/T8(C8)) \ X{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) VCF(T6,6)VCF(T7,7) VCF(T8,8)\ X E/**/F G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4),CCF(T5,5), \ X CCF(T6,6),CCF(T7,7),CCF(T8,8) \ X JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6) JCF(T7,7) \ X JCF(T8,8)); WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) \ X WCF(T6,6) WCF(T7,7) WCF(T8,8) X/**/F} X X#define PROTOCCALLSFFUN9(F,NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ XU/**/F C_(NAME)(); \ Xstatic U/**/F CFFUN(NAME)(U/**/T1 A1,U/**/T2 A2,U/**/T3 A3,U/**/T4 A4, \ X U/**/T5 A5,U/**/T6 A6,U/**/T7 A7,U/**/T8 A8,U/**/T9 A9 \ X H/**/T1(C1) H/**/T2(C2) H/**/T3(C3) H/**/T4(C4) H/**/T5(C5) H/**/T6(C6) \ X H/**/T7(C7) H/**/T8(C8) H/**/T9(C9)) \ X{VCF(T1,1) VCF(T2,2) VCF(T3,3) VCF(T4,4) VCF(T5,5) VCF(T6,6)VCF(T7,7) VCF(T8,8)\ X VCF(T9,9) E/**/F G/**/F(NAME)CCF(T1,1),CCF(T2,2),CCF(T3,3),CCF(T4,4), \ X CCF(T5,5),CCF(T6,6),CCF(T7,7),CCF(T8,8),CCF(T9,9) \ X JCF(T1,1) JCF(T2,2) JCF(T3,3) JCF(T4,4) JCF(T5,5) JCF(T6,6) JCF(T7,7) \ X JCF(T8,8) JCF(T9,9)); WCF(T1,1) WCF(T2,2) WCF(T3,3) WCF(T4,4) WCF(T5,5) \ X WCF(T6,6) WCF(T7,7) WCF(T8,8) WCF(T9,9) X/**/F} X X/*-------------------------------------------------------------------------*/ X X/* UTILITIES FOR FORTRAN TO CALL C ROUTINES */ X X#ifdef VAXC /* To avoid %CC-I-PARAMNOTUSED. */ X#pragma nostandard X#endif X X#define DDOUBLE( A) X#define DFLOAT( A) X#define DINT( A) X#define DLOGICAL( A) X#define DLONG( A) X#define DDOUBLEV( A) X#define DFLOATV( A) X#define DINTV( A) X#define DDOUBLEVV( A) X#define DFLOATVV( A) X#define DINTVV( A) X#define DPDOUBLE( A) X#define DPFLOAT( A) X#define DPINT( A) X#define DPLOGICAL( A) X#define DPLONG( A) X#define DPVOID( A) X#ifdef vms X#define DSTRING( A) X#else X#define DSTRING( A) ,unsigned A X#endif X#define DSTRINGV DSTRING X#define DPSTRING DSTRING X#define DPSTRINGV DSTRING X X#define QDOUBLE( A) X#define QFLOAT( A) X#define QINT( A) X#define QLOGICAL( A) X#define QLONG( A) X#define QDOUBLEV( A) X#define QFLOATV( A) X#define QINTV( A) X#define QDOUBLEVV( A) X#define QFLOATVV( A) X#define QINTVV( A) X#define QPDOUBLE( A) X#define QPFLOAT( A) X#define QPINT( A) X#define QPLOGICAL( A) X#define QPLONG( A) X#define QPVOID( A) X#ifdef vms X#define QSTRINGV( A) char *A; X#else X#define QSTRINGV( A) char *A; unsigned int A/**/N; X#endif X#define QSTRING( A) char *A; X#define QPSTRING( A) char *A; X#define QPSTRINGV QSTRINGV X X#define TCF(NAME,TN,I) T/**/TN(NAME,A/**/I,B/**/I,D/**/I) X#define TDOUBLE( M,A,B,D) *A X#define TFLOAT( M,A,B,D) *A X#define TINT( M,A,B,D) *A X#define TLOGICAL( M,A,B,D) *A X#define TLONG( M,A,B,D) *A X#define TDOUBLEV( M,A,B,D) A X#define TFLOATV( M,A,B,D) A X#define TINTV( M,A,B,D) A X#define TDOUBLEVV(M,A,B,D) A X#define TFLOATVV( M,A,B,D) A X#define TINTVV( M,A,B,D) A X#define TPDOUBLE( M,A,B,D) A X#define TPFLOAT( M,A,B,D) A X#define TPINT( M,A,B,D) A X#define TPLOGICAL(M,A,B,D) A X#define TPLONG( M,A,B,D) A X#define TPVOID( M,A,B,D) A X#ifdef vms X#define TSTRING( M,A,B,D)((B=malloc(A->dsc$w_length+1))[A->dsc$w_length]='\0',\ X kill_trailing(memcpy(B,A->dsc$a_pointer,A->dsc$w_length),' ')) X#define TSTRINGV( M,A,B,D) \ X (B=malloc((A->dsc$w_length+1)*A->dsc$l_m[0]), (void *)F2CSTRVCOPY(B,A)) X#else X#define TSTRING( M,A,B,D) (memcpy(B=malloc(D+1),A,D),B[D]='\0', \ X kill_trailing(B,' ')) X#define TSTRINGV( M,A,B,D) (B/**/N=num_elem(A,D,M/**/_STRV_/**/A), \ X (void *)vkill_trailing(f2cstrv(A,B=malloc(B/**/N*(D+1)),D+1,B/**/N*(D+1)),\ X D+1,B/**/N*(D+1),' ')) X#endif X#define TPSTRING TSTRING X#define TPSTRINGV TSTRINGV X X#define RCF(TN,I) R/**/TN(A/**/I,B/**/I,D/**/I) X#define RDOUBLE( A,B,D) X#define RFLOAT( A,B,D) X#define RINT( A,B,D) X#define RLOGICAL( A,B,D) X#define RLONG( A,B,D) X#define RDOUBLEV( A,B,D) X#define RFLOATV( A,B,D) X#define RINTV( A,B,D) X#define RDOUBLEVV(A,B,D) X#define RFLOATVV( A,B,D) X#define RINTVV( A,B,D) X#define RPDOUBLE( A,B,D) X#define RPFLOAT( A,B,D) X#define RPINT( A,B,D) X#define RPLOGICAL(A,B,D) X#define RPLONG( A,B,D) X#define RPVOID( A,B,D) X#define RSTRING( A,B,D) free(B); X#define RSTRINGV( A,B,D) free(B); X#ifdef vms X#define RPSTRING( A,B,D) \ X memcpy(A->dsc$a_pointer,B,MIN(strlen(B),A->dsc$w_length)), \ X (A->dsc$w_length>strlen(B)? \ X memset(A->dsc$a_pointer+strlen(B),' ', A->dsc$w_length-strlen(B)):0),free(B); X#define RPSTRINGV(A,B,D) C2FSTRVCOPY(B,A), free(B); X#else X#define RPSTRING( A,B,D) memcpy(A,B,MIN(strlen(B),D)), \ X (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), free(B); X#define RPSTRINGV(A,B,D) c2fstrv(B,A,D+1,(D+1)*B/**/N), free(B); X#endif X X#define FZDOUBLE( A) double fcallsc(A)( X#define FZFLOAT( A) float fcallsc(A)( X#define FZINT( A) int fcallsc(A)( X#define FZLOGICAL( A) int fcallsc(A)( X#define FZLONG( A) long fcallsc(A)( X#define FZVOID( A) void fcallsc(A)( X#ifdef vms X#define FZSTRING( A) void fcallsc(A)(fstring *AS X#else X#define FZSTRING( A) void fcallsc(A)(char *AS, unsigned D0 X#endif X X#define FDOUBLE( A) double fcallsc(A)( X#define FFLOAT( A) float fcallsc(A)( X#define FINT( A) int fcallsc(A)( X#define FLOGICAL( A) int fcallsc(A)( X#define FLONG( A) long fcallsc(A)( X#define FVOID( A) void fcallsc(A)( X#define FSTRING( A) FZSTRING(A), X X#define LDOUBLE( NAME) A0=ccallsc(NAME) X#define LFLOAT( NAME) A0=ccallsc(NAME) X#define LINT( NAME) A0=ccallsc(NAME) X#define LLOGICAL(NAME) A0=ccallsc(NAME) X#define LLONG( NAME) A0=ccallsc(NAME) X#define LSTRING( NAME) A0=ccallsc(NAME) X#define LVOID( NAME) ccallsc(NAME) X X#define KDOUBLE X#define KFLOAT X#define KINT X#define KLOGICAL X#define KLONG X#define KVOID X/* KSTRING copies the string into the position provided by the caller. */ X#ifdef vms X#define KSTRING \ X memcpy(AS->dsc$a_pointer,A0, MIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))) ); \ X AS->dsc$w_length>(A0==NULL?0:strlen(A0))? \ X memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ', \ X AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0; X#else X#define KSTRING memcpy(AS,A0, MIN(D0,(A0==NULL?0:strlen(A0))) ); \ X D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \ X ' ', D0-(A0==NULL?0:strlen(A0))):0; X#endif X X/* Note that K.. and I.. can't be combined since K.. has to access data before XR.., in order for functions returning strings which are also passed in as Xarguments to work correctly. Note that R.. frees and hence may corrupt the Xstring. */ X#define IDOUBLE return A0; X#define IFLOAT return A0; X#define IINT return A0; X#define ILOGICAL return A0; X#define ILONG return A0; X#define ISTRING return ; X#define IVOID return ; X X#ifdef VAXC /* Have avoided %CC-I-PARAMNOTUSED. */ X#pragma standard X#endif X X#define FCALLSCSUB0(NAME) FCALLSCFUN0(VOID,NAME) X#define FCALLSCSUB1(NAME,T1) FCALLSCFUN1(VOID,NAME,T1) X#define FCALLSCSUB2(NAME,T1,T2) FCALLSCFUN2(VOID,NAME,T1,T2) X#define FCALLSCSUB3(NAME,T1,T2,T3) FCALLSCFUN3(VOID,NAME,T1,T2,T3) X#define FCALLSCSUB4(NAME,T1,T2,T3,T4) FCALLSCFUN4(VOID,NAME,T1,T2,T3,T4) X#define FCALLSCSUB5(NAME,T1,T2,T3,T4,T5) FCALLSCFUN5(VOID,NAME,T1,T2,T3,T4,T5) X#define FCALLSCSUB6(NAME,T1,T2,T3,T4,T5,T6) \ X FCALLSCFUN6(VOID,NAME,T1,T2,T3,T4,T5,T6) X#define FCALLSCSUB7(NAME,T1,T2,T3,T4,T5,T6,T7) \ X FCALLSCFUN7(VOID,NAME,T1,T2,T3,T4,T5,T6,T7) X#define FCALLSCSUB8(NAME,T1,T2,T3,T4,T5,T6,T7,T8) \ X FCALLSCFUN8(VOID,NAME,T1,T2,T3,T4,T5,T6,T7,T8) X#define FCALLSCSUB9(NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ X FCALLSCFUN9(VOID,NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9) X X#define FCALLSCFUN0(T0,NAME) \ XFZ/**/T0(NAME)) {U/**/T0 A0; L/**/T0(NAME)(); K/**/T0 I/**/T0} X X#define FCALLSCFUN1(T0,NAME,T1) \ XF/**/T0(NAME)N/**/T1 A1 D/**/T1(D1)) {U/**/T0 A0; Q/**/T1(B1) \ X L/**/T0(NAME)(TCF(NAME,T1,1)); K/**/T0 RCF(T1,1) I/**/T0} X X#define FCALLSCFUN2(T0,NAME,T1,T2) \ XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2 D/**/T1(D1) D/**/T2(D2)) \ X{U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2) \ X L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2));K/**/T0 RCF(T1,1)RCF(T2,2)I/**/T0} X X#define FCALLSCFUN3(T0,NAME,T1,T2,T3) \ XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3 D/**/T1(D1) D/**/T2(D2) \ X D/**/T3(D3)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3) \ X L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),TCF(NAME,T3,3)); \ X K/**/T0 RCF(T1,1) RCF(T2,2) RCF(T3,3) I/**/T0} X X#define FCALLSCFUN4(T0,NAME,T1,T2,T3,T4) \ XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4 D/**/T1(D1) \ X D/**/T2(D2) D/**/T3(D3) D/**/T4(D4)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2) \ X Q/**/T3(B3) Q/**/T4(B4) L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2), \ X TCF(NAME,T3,3),TCF(NAME,T4,4)); K/**/T0 RCF(T1,1)RCF(T2,2) RCF(T3,3) RCF(T4,4)\ X I/**/T0} X X#define FCALLSCFUN5(T0,NAME,T1,T2,T3,T4,T5) \ XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5 \ X D/**/T1(D1) D/**/T2(D2) D/**/T3(D3) D/**/T4(D4) D/**/T5(D5)) {U/**/T0 A0; \ X Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3) Q/**/T4(B4) Q/**/T5(B5) \ X L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),TCF(NAME,T3,3),TCF(NAME,T4,4), \ X TCF(NAME,T5,5)); K/**/T0 RCF(T1,1)RCF(T2,2)RCF(T3,3)RCF(T4,4)RCF(T5,5) I/**/T0} X X#define FCALLSCFUN6(T0,NAME,T1,T2,T3,T4,T5,T6) \ XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5, \ X N/**/T6 A6 D/**/T1(D1) D/**/T2(D2) D/**/T3(D3) D/**/T4(D4) D/**/T5(D5) \ X D/**/T6(D6)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3) Q/**/T4(B4) \ X Q/**/T5(B5) Q/**/T6(B6) L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2), \ X TCF(NAME,T3,3),TCF(NAME,T4,4),TCF(NAME,T5,5),TCF(NAME,T6,6)); K/**/T0 \ X RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5) RCF(T6,6) I/**/T0} X X#define FCALLSCFUN7(T0,NAME,T1,T2,T3,T4,T5,T6,T7) \ XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5, \ X N/**/T6 A6 N/**/T7 A7 D/**/T1(D1) D/**/T2(D2) D/**/T3(D3) D/**/T4(D4) \ X D/**/T5(D5) D/**/T6(D6) D/**/T7(D7)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2) \ X Q/**/T3(B3) Q/**/T4(B4) Q/**/T5(B5) Q/**/T6(B6) Q/**/T7(B7) \ X L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),TCF(NAME,T3,3),TCF(NAME,T4,4), \ X TCF(NAME,T5,5),TCF(NAME,T6,6),TCF(NAME,T7,7)); K/**/T0 \ X RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5) RCF(T6,6) RCF(T7,7) I/**/T0} X X#define FCALLSCFUN8(T0,NAME,T1,T2,T3,T4,T5,T6,T7,T8) \ XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5, \ X N/**/T6 A6 N/**/T7 A7 N/**/T8 A8 D/**/T1(D1) D/**/T2(D2) D/**/T3(D3) \ X D/**/T4(D4) D/**/T5(D5) D/**/T6(D6) D/**/T7(D7) D/**/T8(D8)) {U/**/T0 A0; \ X Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3) Q/**/T4(B4) Q/**/T5(B5) Q/**/T6(B6) \ X Q/**/T7(B7) Q/**/T8(B8) L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2), \ X TCF(NAME,T3,3),TCF(NAME,T4,4),TCF(NAME,T5,5),TCF(NAME,T6,6),TCF(NAME,T7,7), \ X TCF(NAME,T8,8)); K/**/T0 RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5) \ X RCF(T6,6) RCF(T7,7) RCF(T8,8) I/**/T0} X X#define FCALLSCFUN9(T0,NAME,T1,T2,T3,T4,T5,T6,T7,T8,T9) \ XF/**/T0(NAME)N/**/T1 A1,N/**/T2 A2,N/**/T3 A3,N/**/T4 A4,N/**/T5 A5, \ X N/**/T6 A6 N/**/T7 A7 N/**/T8 A8 N/**/T9 A9 D/**/T1(D1) D/**/T2(D2) \ X D/**/T3(D3) D/**/T4(D4) D/**/T5(D5) D/**/T6(D6) D/**/T7(D7) D/**/T8(D8) \ X D/**/T8(D8) D/**/T9(D9)) {U/**/T0 A0; Q/**/T1(B1) Q/**/T2(B2) Q/**/T3(B3) \ X Q/**/T4(B4) Q/**/T5(B5) Q/**/T6(B6) Q/**/T7(B7) Q/**/T8(B8) Q/**/T9(B9) \ X L/**/T0(NAME)(TCF(NAME,T1,1),TCF(NAME,T2,2),TCF(NAME,T3,3),TCF(NAME,T4,4), \ X TCF(NAME,T5,5),TCF(NAME,T6,6),TCF(NAME,T7,7),TCF(NAME,T8,8),TCF(NAME,T9,9)); \ X K/**/T0 RCF(T1,1) RCF(T2,2) RCF(T3,3) RCF(T4,4) RCF(T5,5) \ X RCF(T6,6) RCF(T7,7) RCF(T8,8) RCF(T9,9) I/**/T0} X X X#endif /* __CFORTRAN_LOADED */ X#endif /* This is VMS, Mips or IBMR2. */ END_OF_FILE if test 54924 -ne `wc -c <'cfortran.h'`; then echo shar: \"'cfortran.h'\" unpacked with wrong size! fi # end of 'cfortran.h' fi echo shar: End of archive 2 $of 2$. cp /dev/null ark2isdone MISSING="" for I in 1 2 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked both archives. rm -f ark[1-9]isdone else echo You still must unpack the following archives: echo " " ${MISSING} fi exit 0 exit 0 # Just in case... -- Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM Sterling Software, IMD UUCP: uunet!sparky!kent Phone: (402) 291-8300 FAX: (402) 291-4362 Please send comp.sources.misc-related mail to kent@uunet.uu.net.