Consider the following example of a C program which calls a FORTRAN subroutine which returns a CHARACTER array produced by setting to blank every non-blank element of a given array for which the corresponding element of a given LOGICAL array is TRUE. A LOGICAL output array is produced with TRUE in the element corresponding with each element of the CHARACTER array which has been reset, and FALSE elsewhere.
#include <stdio.h> #include "f77.h" F77_SUBROUTINE(str_reset)(CHARACTER_ARRAY(in), LOGICAL_ARRAY(lin), INTEGER(dim1), INTEGER(dim2), CHARACTER_ARRAY(out), LOGICAL_ARRAY(lout) TRAIL(in) TRAIL(out) ); void main(){ char inarr[3][2][4]={{"Yes","No "},{" "," "},{"No ","Yes"}}; int inarr_length=4; char outarr[3][2][4]; int outarr_length=4; int lin[3][2]={{1,0},{1,1},{0,1}}; int lout[3][2]; DECLARE_CHARACTER_ARRAY(fin,3,2][4); DECLARE_CHARACTER_ARRAY_DYN(fout); DECLARE_LOGICAL_ARRAY(flin,3][2); DECLARE_LOGICAL_ARRAY_DYN(flout); DECLARE_INTEGER(dim1); DECLARE_INTEGER(dim2); int ndims=2; int dims[2]={3,2}; int i,j; F77_CREATE_CHARACTER_ARRAY_M(fout,3,ndims,dims); F77_CREATE_LOGICAL_ARRAY_M(flout,ndims,dims); (void) cnfExprta( (char *)inarr, inarr_length, (char *)fin, fin_length, ndims, dims ); (void) cnfExpla( (int *)lin, (F77_LOGICAL_TYPE *)flin, ndims, dims ); dim1 = dims[0]; dim2 = dims[1]; F77_CALL(str_reset)( CHARACTER_ARRAY_ARG(fin), LOGICAL_ARRAY_ARG(flin), INTEGER_ARG(&dim1), INTEGER_ARG(&dim2), CHARACTER_ARRAY_ARG(fout), LOGICAL_ARRAY_ARG(flout) TRAIL_ARG(fin) TRAIL_ARG(fout) ); (void) cnfImprta ( fout, fout_length, outarr[0][0], outarr_length, ndims, dims ); (void) cnfImpla( (F77_LOGICAL_TYPE *)flout, (int *)lout, ndims, dims ); F77_FREE_CHARACTER(fout); F77_FREE_LOGICAL(flout); printf("i j in lin out lout\n"); for (j=0;j<3;j++){ for (i=0;i<2;i++){ printf("%d %d %c %s %c %s\n", i, j, lin[j][i]?'T':'F', inarr[j][i], lout[j][i]?'T':'F', outarr[j][i] ); } } }
SUBROUTINE STR_RESET( ARRAY, LIN, DIM1, DIM2, OUT, LOUT ) * Purpose: * Reset elements of an array * Arguments: * ARRAY(2,3)=CHARACTER*(*) (Given) * The array to be altered * LIN(2,3)=LOGICAL (Given) * The given LOGICAL array * DIM1=INTEGER (Given) * The first dimension of the arrays * DIM2=INTEGER (Given) * The second dimension of the arrays * OUT(2,3)=CHARACTER*(*) (Returned) * LOUT(2,3)=LOGICAL (Returned) IMPLICIT NONE INTEGER I, J INTEGER DIM1, DIM2 CHARACTER*(*) ARRAY(2,3) CHARACTER*(*) OUT(2,3) LOGICAL LIN(2,3) LOGICAL LOUT(2,3) DO 20, J = 1, 3 DO 10, I = 1, 2 IF( LIN(I,J) .AND. (ARRAY(I,J) .NE. ' ') )THEN OUT(I,J) = ' ' LOUT(I,J) = .TRUE. ELSE OUT(I,J) = ARRAY(I,J) LOUT(I,J) = .FALSE. END IF 10 ENDDO 20 ENDDO END
As an example of how to write a C function to be called from FORTRAN with array arguments, the above subroutine could be re-written in C as follows:
#include "f77.h" F77_SUBROUTINE(str_reset)(CHARACTER_ARRAY(in_f), LOGICAL_ARRAY(lin_f), INTEGER(dim1), INTEGER(dim2), CHARACTER_ARRAY(out_f), LOGICAL_ARRAY(lout_f) TRAIL(in_f) TRAIL(out_f) ) { GENPTR_CHARACTER_ARRAY(in_f) GENPTR_LOGICAL_ARRAY(lin_f) GENPTR_INTEGER(dim1) GENPTR_INTEGER(dim2) GENPTR_CHARACTER_ARRAY(out_f) GENPTR_LOGICAL_ARRAY(lout_f) int i, j, nels, cpt; char *in_c, *out_c; int *lin_c, *lout_c; int ndims=2; int dims[2]; dims[0] = *dim1; dims[1] = *dim2; nels = *dim1 * *dim2; in_c = cnfCreat( nels*(in_f_length+1) ); out_c = cnfCreat( nels*(out_f_length+1) ); lin_c = (int *)malloc( nels*sizeof(int) ); lout_c = (int *)malloc( nels*sizeof(int) ); cnfImprta( in_f, in_f_length, in_c, in_f_length+1, ndims, dims ); cnfImpla( lin_f, lin_c, ndims, dims ); cpt = 0; for(i=0;i<nels;i++){ if( *(lin_c+i) && strlen( in_c+cpt ) ) { strcpy(out_c+cpt,""); *(lout_c+i) = 1; } else { strcpy( out_c+cpt, in_c+cpt ); *(lout_c+i) = 0; } cpt += in_f_length+1; } cnfExprta( out_c, out_f_length+1, out_f, out_f_length, ndims, dims ); cnfExpla( lout_c, lout_f, ndims, dims ); cnfFree( in_c ); cnfFree( out_c ); free( lin_c ); free( lout_c ); }
CNF and F77 Mixed Language Programming -- FORTRAN and C