CHARACTER and LOGICAL Arrays

There are two versions of the macros for creating dynamic CHARACTER and LOGICAL arrays: F77_CREATE_CHARACTER_ARRAY will create a 1-dimensional array with the given number of elements, and F77_CREATE_CHARACTER_ARRAY_M will create an array whose size is defined by an integer specifying the number of dimensions and an array of integers specifying each dimension. Similarly F77_CREATE_LOGICAL_ARRAY and F77_CREATE_LOGICAL_ARRAY_M

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.

Example - Import and export of arrays..

#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 );
}