Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Budiardja, Reuben
Fortran Frontier
Commits
d6288302
Commit
d6288302
authored
Dec 05, 2019
by
Budiardja, Reuben
Browse files
WIP constructing test case for C_Descriptor.
parent
7bb281e7
Changes
3
Hide whitespace changes
Inline
Side-by-side
Cases/Fortran2018/C_Descriptors/C_Allocate.c
0 → 100644
View file @
d6288302
#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
]);
}
Cases/Fortran2018/C_Descriptors/C_AllocateModule.f90
0 → 100644
View file @
d6288302
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
Cases/Fortran2018/C_Descriptors/C_AllocateProgram.f90
0 → 100644
View file @
d6288302
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
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment