aboutsummaryrefslogtreecommitdiff
path: root/include/f77_wrap.h
diff options
context:
space:
mode:
authorJoseph Hunkeler <jhunkeler@gmail.com>2015-03-05 18:05:27 -0500
committerJoseph Hunkeler <jhunkeler@gmail.com>2015-03-05 18:05:27 -0500
commit4a3aef3f7236d2b3267aead61f11c587c6f4bddb (patch)
treebea89287f8cf6290fc230fb82fb11b3b9a5c6e0f /include/f77_wrap.h
parent9166f1762976cb64acfd8c9ecc067132ffefa615 (diff)
downloadcalfuse-4a3aef3f7236d2b3267aead61f11c587c6f4bddb.tar.gz
Further improvements
Diffstat (limited to 'include/f77_wrap.h')
-rw-r--r--include/f77_wrap.h277
1 files changed, 0 insertions, 277 deletions
diff --git a/include/f77_wrap.h b/include/f77_wrap.h
deleted file mode 100644
index 121850f..0000000
--- a/include/f77_wrap.h
+++ /dev/null
@@ -1,277 +0,0 @@
-#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) \
- }
-