From 4a3aef3f7236d2b3267aead61f11c587c6f4bddb Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Thu, 5 Mar 2015 18:05:27 -0500 Subject: Further improvements --- include/f77_wrap.h | 277 ----------------------------------------------------- 1 file changed, 277 deletions(-) delete mode 100644 include/f77_wrap.h (limited to 'include/f77_wrap.h') 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;idsc$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;idsc$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