Commit 6be905d1 authored by Budiardja, Reuben's avatar Budiardja, Reuben
Browse files

Simplified test and more output for debugging.

parent 8afc3a45
......@@ -12,14 +12,14 @@ void C_Allocate ( CFI_cdesc_t *A_DV, CFI_cdesc_t *ShapeDV, int *Status )
CFI_index_t *lbounds, *ubounds;
printf("=== Entering C_Allocate === \n");
printf("A_DV.rank: %d\nShapeDV.elem_len: %d\n",
A_DV->rank, (int) ShapeDV->dim[0].extent);
// Error checking
if ( A_DV->rank != ShapeDV->elem_len )
if ( A_DV->rank != ShapeDV->dim[0].extent )
{
printf("-- Rank and Shape is not consistent\n");
printf("-- Rank: %d, Shape: %d\n", A_DV->rank, ShapeDV->elem_len);
//*Status = -1;
//return;
printf("ERROR: Rank and Shape is not consistent\n");
*Status = -1;
return;
}
lbounds = (CFI_index_t *) malloc ( sizeof ( CFI_index_t ) * A_DV->rank );
......
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
module C_AllocateModule
use iso_c_binding
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 ( : ), allocatable, &
intent ( in ) :: &
Shape
integer ( c_int ), intent ( out ) :: &
Status
end subroutine C_Allocate
end interface
contains
function C_PtrString ( P ) result ( CP )
type ( c_ptr ), intent ( in ) :: &
P
character ( 1024 ) :: &
CP
integer ( selected_int_kind ( 15 ) ) :: &
Address
Address = transfer ( P, selected_int_kind ( 15 ) )
write ( CP, fmt = ' ( z64 )' ) Address
CP = '0x' // adjustl ( CP )
end function C_PtrString
end module C_AllocateModule
program C_AllocatorProgram
use iso_c_binding
......@@ -7,28 +54,29 @@ program C_AllocatorProgram
integer ( c_int ):: &
Status
integer ( c_int ), dimension ( 3 ) :: &
integer ( c_int ), dimension ( : ), allocatable :: &
A_Shape
real ( KDR ), dimension ( :, :, : ), allocatable :: &
real ( KDR ), dimension ( :, :, : ), allocatable, target :: &
Array
Status = - huge ( 1 )
allocate ( A_Shape ( 3 ) )
A_Shape = [ 10, 20, 3 ]
!--FIXME: the following caused gcc/10.1 to crash
!print*, 'Requested shape', A_Shape
print*, 'Requested with shape', A_Shape
call C_Allocate ( Array, A_Shape, Status )
if ( Status == 0 ) then
print*, 'is Array Allocated? ', allocated ( Array )
!-- FIXME: shape causes GCC to crash
!print*, 'Shape:', shape ( Array )
print*, 'size:', size ( Array )
!print*, 'lbounds', lbound ( Array )
!print*, 'ubounds', ubound ( Array )
print*, 'is array allocated? ', allocated ( Array )
!-- FIXME: the following causes GCC to crash
print*, 'shape: ', shape ( Array )
print*, 'size: ', size ( Array )
print*, 'lbounds ', lbound ( Array )
print*, 'ubounds ', ubound ( Array )
print*, 'location ', trim ( C_PtrString ( c_loc ( Array ) ) )
else
print*, 'Allocation failed'
end if
......
#!/bin/bash
gcc --version
gfortran --version
CC=xlc
FC=xlf2008
#CC=gcc
#FC=gfortran
#${CC} --qversion
#${FC} --qversion
set -o verbose
rm *.o *.mod a.out
rm -f *.o *.mod a.out
gcc -c C_Allocate.c
gfortran -c C_AllocateModule.f90
gfortran C_AllocateProgram.f90 C_Allocate.o C_AllocateModule.o
${CC} -c C_Allocate.c -I${OLCF_XL_ROOT}/xlf/16.1.1/include
#${FC} -c C_AllocateModule.f90
${FC} C_AllocateProgram.f90 C_Allocate.o
Supports Markdown
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