= Fortran Translation Issues =

== 1. Fortran Array Section Transformation ==

Here is the prototype of handling Fortran array sections:

{{{
/* e.g., 
 PROGRAM EXAMPLE
   INTEGER SRC_ARR(1:3:1)      
!  source array   SRC_ARR        := /(1)=x,(2)=y,(3)=z/
!  source section SRC_ARR(1:3:2) := /(1)=x,      (3)=z/
   CALL CUT(2, SRC_ARR(1:3:2)) 
 END   
 SUBROUTINE CUT(N, SRC_SEC)
   INTEGER CUR_ARR(2:4:2)
   CUR_ARR = SRC_SEC 
!  current array  CUR_ARR        := /(2)=x,      (4)=z/
 END
!  note1: the current array and its source section      
!  SAME shift: CUR_ARR and SRC_ARR(1:3:2) have a same 
!              1st elem., which is x.
!  DIFF index: The 1st elem. has an index of 2 in 
!              CUR_ARR, while 1 in SRC_ARR(1:3:2).
!  note2: the source section and its source array 
!  SAME index: SRC_ARR and SRC_ARR(1:3:2) have a same
!              indexing system.
!  DIFF shift: their 2nd element are different.
*/

#include <stdlib.h>
#include <stdio.h>
#include <string.h>

typedef struct CIVL_FORTRAN_ARRAY {
  // The number of dimensions
  int num_dims;
  // Dimention Info
  int *lbnds; // Left bounds for each dim.
  int *rbnds; // Right bounds for each dim.
  int *dists; // Distances of two neighbour elements in each dim.   
  // Data Info
  unsigned int size_data;
  void* data;
  // Source CIVL_FORTRAN_ARRAY_TYPE
  struct CIVL_FORTRAN_ARRAY *src_arr;
} * f_arr;

/* Returns the sequential position in a row-major order */
int calc_seq_pos(f_arr arr, int shfts[]) {
  int n_dims = arr->num_dims;
  int *lbnds = arr->lbnds;
  int *rbnds = arr->rbnds;
  int *dists = arr->dists;
  int seq_pos = 0;
  int size_dim = 1;

  for(int i=n_dims-1; i>=0; i--) {
    seq_pos += (shfts[i]) * size_dim;
    size_dim *= (rbnds[i] - lbnds[i]) / dists[i] + 1;
  }
  return seq_pos;
}

int get_seq_pos(f_arr arr, int idxes[]) {
  /* PRE: 'arr' shall NOT be NULL. */
  // EXTRACT: the cur. arr. info.
  int n_dims = arr->num_dims;
  int *lbnds = arr->lbnds;
  int *dists = arr->dists;
  int shfts[n_dims];

  // CALC.: rel. shifts for each dim. in cur. arr.
  for (int i=0; i<n_dims; i++)
    shfts[i] = (idxes[i] - lbnds[i]) / dists[i];

  // FETCH: the src. sec. of the cur. arr. 'arr' 
  f_arr sec = arr->src_arr;

  if (sec == NULL) 
    // the cur. arr. is the original one.
    return calc_seq_pos(arr, shfts);
  //else calc. the abs. indexes in src. arr.
    
  int idxes_src[n_dims];
  
  // EXTRACT: the source section info.
  lbnds = sec->lbnds;
  dists = sec->dists;
  // CALC.: abs. indexes for each dim. in the src. arr.
  for (int i=0; i<n_dims; i++)
    idxes_src[i] = lbnds[i] + shfts[i] * dists[i];
  // TRACE: to the original array entity recursively.
  return get_seq_pos(sec->src_arr, idxes_src);
}

f_arr f_arr_create(unsigned int elem_size, 
		   int dim_num, 
		   int dim_info[3][dim_num]) {
  f_arr arr = (f_arr)malloc(sizeof(struct CIVL_FORTRAN_ARRAY));
  int elem_total = 1;
  int lbnd, rbnd, dist;

  arr->num_dims = dim_num;
  arr->lbnds = (int*)malloc(dim_num * sizeof(int));
  arr->rbnds = (int*)malloc(dim_num * sizeof(int));
  arr->dists = (int*)malloc(dim_num * sizeof(int));
  for (int i=dim_num-1; i>=0; i--) {
    lbnd = dim_info[0][i];
    rbnd = dim_info[1][i];
    dist = dim_info[2][i];
    arr->lbnds[i] = lbnd;
    arr->rbnds[i] = rbnd;
    arr->dists[i] = dist;
    elem_total *= (dim_info[1][i] - dim_info[0][i]) / dim_info[2][i] + 1;
  }
  arr->size_data = elem_size;
  arr->data = malloc(elem_size * elem_total);
  arr->src_arr = NULL;
  return arr;
}

f_arr f_arr_sect(f_arr arr, int sec_info[3][arr->num_dims]) {
  f_arr sec = (f_arr)malloc(sizeof(struct CIVL_FORTRAN_ARRAY));
  int dim_num = arr->num_dims;

  sec->num_dims = dim_num;
  sec->lbnds = (int*)malloc(dim_num * sizeof(int));
  sec->rbnds = (int*)malloc(dim_num * sizeof(int));
  sec->dists = (int*)malloc(dim_num * sizeof(int));
  for (int i=dim_num-1; i>=0; i--) {
    sec->lbnds[i] = sec_info[0][i];
    sec->rbnds[i] = sec_info[1][i];
    sec->dists[i] = sec_info[2][i];
  }
  sec->size_data = arr->size_data;
  sec->data = arr->data;
  sec->src_arr = arr;
  return sec;
}

f_arr f_arr_full(f_arr arr) {
  f_arr img = (f_arr)malloc(sizeof(struct CIVL_FORTRAN_ARRAY));
  int dim_num = arr->num_dims;

  img->num_dims = dim_num;
  img->lbnds = (int*)malloc(dim_num * sizeof(int));
  img->rbnds = (int*)malloc(dim_num * sizeof(int));
  img->dists = (int*)malloc(dim_num * sizeof(int));
  memcpy(img->lbnds, arr->lbnds, dim_num*sizeof(int));
  memcpy(img->rbnds, arr->rbnds, dim_num*sizeof(int));
  memcpy(img->dists, arr->dists, dim_num*sizeof(int));
  img->size_data = arr->size_data;
  img->data = arr->data;
  img->src_arr = arr;
  return img;
}

void *f_arr_read(f_arr arr, int idxes[]) {
  int seq_pos = get_seq_pos(arr, idxes);

  return (arr->data) + seq_pos*arr->size_data;
}

void f_arr_write(f_arr arr, int idxes[], void* val) {
  void *elem = f_arr_read(arr, idxes);

  memcpy(elem, val, arr->size_data); 
}

void f_arr_destroy(f_arr arr){
  free(arr->lbnds);
  free(arr->rbnds);
  free(arr->dists);
  if (arr->src_arr == NULL)
    free(arr->data);
  else
    arr->data = NULL;
  free(arr);
}

/****************************************************/

void arr1d_print(f_arr _IARR) {
  // INTEGER IARR(2:4:2)
  f_arr IARR = f_arr_sect(_IARR, (int[3][1]){{2}, {4}, {2}});

  // DO I=2, 4, 2
  // PRINT(IARR(I))
  // END DO
  for (int i=2; i<=4; i+=2) {
    printf("%d\n", *((int*)f_arr_read(IARR, (int[]){i})));
  }
  f_arr_destroy(IARR);
}

void _arr1d_print(const int n, f_arr _IARR) {
  // INTEGER IARR(N)
  f_arr IARR = f_arr_sect(_IARR, (int[3][1]){{1}, {n}, {1}});
    
  // DO I=1, N
  // PRINT(IARR(I))
  // END DO
  for (int i=1; i<=n; i+=1) {
    printf("%d\n", *((int*)f_arr_read(IARR, (int[]){i})));
  }
  f_arr_destroy(IARR);
}

void test_arr1d () {
  // INTEGER A(1:3:1);
  f_arr A = f_arr_create(sizeof(int), 1, (int[3][1]){{1}, {3}, {1}});
  // DO I=1, 3
  // A(I) = I*I;
  // END DO
  for(int i=1; i<=3; i++) {
    int val = i*i;

    f_arr_write(A, (int[]){i}, &val);
  }
  // ARR1D_PRINT(A(1:3:2))
  f_arr sec_A_0 = f_arr_sect(A, (int[3][1]){{1}, {3}, {2}}); 
  arr1d_print(sec_A_0);
  f_arr_destroy(sec_A_0);
  f_arr sec_A_1 = f_arr_sect(A, (int[3][1]){{2}, {3}, {1}});
  _arr1d_print(2, sec_A_1);
  f_arr_destroy(sec_A_1);
  f_arr_destroy(A);
}

/************************************************/

void mat_print(const int n,const int m, f_arr _mat) {
  // INTEGER MAT(N, M)
  f_arr mat = f_arr_sect(_mat, (int[3][2]){{1,1}, {m,n}, {1,1}});

  // DO I=1,M
  // DO J=1,N
  // PRINT(MAT(J,I), ", ")
  // END DO
  // PRINT("\n")
  // END DO
 for (int i=1; i<=m; i++) {
    for (int j=1; j<=n; j++)
      printf("%d%s", *((int*)f_arr_read(mat, (int[2]){i, j})), ", ");
    printf("%s", "\n");
  }
}

void mxm(int n1, f_arr _ia, int n2, f_arr _ib, int n3, f_arr _ic) {
  // INTEGER N1, N2, N3
  // INTEGER IA(N2, N1), IB(N3, N2), IC(N3, N1)
  f_arr ia = f_arr_sect(_ia, (int[3][2]){{1,1}, {n1,n2}, {1,1}});
  f_arr ib = f_arr_sect(_ib, (int[3][2]){{1,1}, {n2,n3}, {1,1}});
  f_arr ic = f_arr_sect(_ic, (int[3][2]){{1,1}, {n1,n3}, {1,1}});

  for (int j=1; j<=n3; j++) 
    for (int i=1; i<=n1; i++)
      for (int k=1; k<=n2; k++) {
	int val_ic = 
	  *(int*)f_arr_read(ic, (int[2]){j, i}) +
	  *(int*)f_arr_read(ia, (int[2]){k, i}) *
	  *(int*)f_arr_read(ib, (int[2]){j, k});
	f_arr_write(ic, (int[2]){j, i}, &val_ic);
      }
}

void test_mxm() {
  // INTEGER N1=2, N2=1, N3=3
  int n1=2, n2=1, n3=3;
  // INTEGER IA(N1, N2), IB(N2, N3), IC(N1, N3)
  f_arr ia = f_arr_create(sizeof(int), 2, 
			  (int[3][2]){{1,1}, {n2, n1}, {1,1}});
  f_arr ib = f_arr_create(sizeof(int), 2, 
			  (int[3][2]){{1,1}, {n3, n2}, {1,1}});
  f_arr ic = f_arr_create(sizeof(int), 2, 
			  (int[3][2]){{1,1}, {n3, n1}, {1,1}});

  // IA = 2
  // IB = -2
  // IC = 0
  for (int j=1; j<=n2; j++)
    for (int i=1; i<=n1; i++) {
      int val_ia = 2;
      f_arr_write(ia, (int[2]){j,i}, &val_ia);
    }
  for (int j=1; j<=n3; j++)
    for (int i=1;i<=n2; i++) {
      int val_ib = -2;
      f_arr_write(ib, (int[2]){j,i}, &val_ib);
    }
  for (int j=1; j<=n3; j++) 
    for (int i=1; i<=n1; i++){
      int val_ic = 0;
      f_arr_write(ic, (int[2]){j,i}, &val_ic);
    }

  f_arr arg_ia, arg_ib, arg_ic;
  // MXM(N1, IA, N2, IB, N3, IC)
  arg_ia = f_arr_full(ia);
  arg_ib = f_arr_full(ib);
  arg_ic = f_arr_full(ic);
  mxm(n1, arg_ia, n2, arg_ib, n3, arg_ic);
  f_arr_destroy(arg_ia);
  f_arr_destroy(arg_ib);
  f_arr_destroy(arg_ic);

  // MAT_PRINT(N, M, IC)
  arg_ic = f_arr_full(ic);
  mat_print(n3,n1,arg_ic);
  f_arr_destroy(arg_ic);

  f_arr_destroy(ia);
  f_arr_destroy(ib);
  f_arr_destroy(ic);
}

int main() {
  //test_arr1d();
  //test_mxm();
  return 0;
}

}}}