Commit d6288302 authored by Budiardja, Reuben's avatar Budiardja, Reuben
Browse files

WIP constructing test case for C_Descriptor.

parent 7bb281e7
#include <stdlib.h>
#include <stdio.h>
#include "ISO_Fortran_binding.h"
void C_Allocate ( CFI_cdesc_t *A_DV, CFI_cdesc_t *ShapeDV, int *Status )
{
int iE;
int *nValues;
// Error checking
if ( A_DV->rank != ShapeDV->elem_len )
{
*Status = -1;
return;
}
nValues = (int *) ShapeDV->base_addr;
for ( iE = 0; iE < ShapeDV->elem_len; iE++ )
printf("iD: %d - len: %d", iE, nValues[iE]);
}
module C_AllocateModule
implicit none
public
integer, parameter :: &
KDR = kind ( 1.0d0 )
interface
subroutine C_Allocate ( A, Shape, Status ) &
bind ( c, name = 'C_Allocate' )
use iso_c_binding
implicit none
real ( c_double ), dimension ( :, :, : ), allocatable, &
intent ( out ) :: &
A
integer ( c_int ), dimension ( : ), intent ( in ) :: &
Shape
integer ( c_int ), intent ( out ) :: &
Status
end subroutine C_Allocate
end interface
end module C_AllocateModule
program C_AllocatorProgram
use C_AllocateModule
implicit none
integer :: &
Status
integer, dimension ( 3 ) :: &
Shape
real ( KDR ), dimension ( :, :, : ), allocatable :: &
Array
Shape = [ 10, 20, 3 ]
call C_Allocate ( Array, Shape, Status )
if ( Status == 0 ) &
print*, 'is Allocated', allocated ( Array )
end program C_AllocatorProgram
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment