Skip to content

Commit 530c9cc

Browse files
zbyerlyzbyerly
committed
Second commit
1 parent 0639f8e commit 530c9cc

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

79 files changed

+13524
-0
lines changed

Diff for: ‎.gitignore

+4
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
*~
2+
*.o
3+
*.mod
4+
main

Diff for: ‎README.md

+6
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,8 @@
11
# fortran_interface_example
22
Example of interfacing a fortran code with a c++ driver
3+
4+
## Build commands:
5+
6+
gfortran -c global.f95
7+
g++ -c main.cpp
8+
g++ -o main global.o main.o -lgfortran

Diff for: ‎boundary_exchange.f95

+96
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,96 @@
1+
subroutine get_neighbors(numneighbors,neighbors,g)
2+
use global_data
3+
implicit none
4+
5+
type (global_type), pointer :: g
6+
7+
integer :: numneighbors
8+
integer :: neighbors(MAX_DOMAIN_NEIGHBORS)
9+
10+
integer :: i
11+
12+
numneighbors = g%NEIGHPROC
13+
14+
do i=1,numneighbors
15+
neighbors(i) = g%IPROC(i)
16+
end do
17+
18+
end subroutine get_neighbors
19+
20+
subroutine get_outgoing_nodes(g, neighbor, num_nodes, alives)
21+
use global_data
22+
implicit none
23+
type (global_type), pointer :: g
24+
integer :: neighbor
25+
integer,intent(out) :: num_nodes
26+
integer :: alives(MAX_BOUNDARY_SIZE)
27+
28+
integer :: i,j,index
29+
logical :: neighbor_found
30+
31+
neighbor_found = .false.
32+
do I=1,g%NEIGHPROC
33+
34+
if (g%IPROC(I).eq.neighbor) then
35+
index = i
36+
neighbor_found = .true.
37+
exit
38+
end if
39+
40+
end do
41+
42+
if (neighbor_found) then
43+
num_nodes = g%NNODSEND(INDEX)
44+
do J=1,g%NNODSEND(INDEX)
45+
alives(J)=g%ALIVE(g%ISENDLOC(J,INDEX))
46+
end do
47+
else
48+
print*, "FORTRAN ERROR: neighbor not found"
49+
stop
50+
end if
51+
52+
end subroutine get_outgoing_nodes
53+
54+
subroutine put_incoming_nodes(g, neighbor, num_nodes, alives)
55+
use global_data
56+
implicit none
57+
58+
type (global_type), pointer :: g
59+
integer :: neighbor
60+
integer :: num_nodes
61+
integer :: alives(MAX_BOUNDARY_SIZE)
62+
63+
integer :: i,j,index
64+
logical :: neighbor_found
65+
66+
neighbor_found = .false.
67+
do I=1,g%NEIGHPROC
68+
69+
if (g%IPROC(i).eq.neighbor) then
70+
index = i
71+
neighbor_found = .true.
72+
exit
73+
end if
74+
75+
end do
76+
77+
78+
if (neighbor_found) then
79+
80+
if (num_nodes.ne.g%NNODRECV(index)) then
81+
print*, "Error, numn_nodes .ne. g%NNODRECV(index)"
82+
print*, "num_nodes = ", num_nodes
83+
print*, "g%NNODRECV(index) = ", g%NNODRECV(index)
84+
stop
85+
end if
86+
87+
do J=1,g%NNODRECV(index)
88+
g%new_alive(g%IRECVLOC(J,I))=alives(J)
89+
end do
90+
91+
else
92+
print*, "FORTRAN ERROR: neighbor not found"
93+
stop
94+
end if
95+
96+
end subroutine put_incoming_nodes

Diff for: ‎cwrappers.f95

+110
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,110 @@
1+
! %%%%%%%%%%%%%%%%%%% c wrappers %%%%%%%%%%%%%%%%%%%%%%%
2+
3+
subroutine init_fort(id, global_c_ptr)
4+
use, intrinsic :: iso_c_binding
5+
use global
6+
implicit none
7+
8+
integer :: id
9+
type (C_PTR), intent(out) :: global_c_ptr
10+
type (global_type), pointer :: gdata
11+
12+
call init(id, gdata)
13+
14+
global_c_ptr = C_LOC(gdata)
15+
16+
end subroutine init_fort
17+
18+
subroutine print_fort(global_c_ptr, timestep)
19+
use, intrinsic :: iso_c_binding
20+
use global
21+
implicit none
22+
23+
type (C_PTR) :: global_c_ptr
24+
type (global_type), pointer :: g
25+
integer :: timestep
26+
27+
call C_F_POINTER(global_c_ptr,g)
28+
29+
call print(g, timestep)
30+
31+
end subroutine print_fort
32+
33+
subroutine update_fort(timestep, global_c_ptr)
34+
use, intrinsic :: iso_c_binding
35+
use global
36+
implicit none
37+
38+
type (C_PTR) :: global_c_ptr
39+
type (global_type), pointer :: g
40+
integer :: timestep
41+
42+
call C_F_POINTER(global_c_ptr,g)
43+
44+
call update(timestep, g)
45+
46+
global_c_ptr = C_LOC(g)
47+
48+
end subroutine update_fort
49+
50+
subroutine term_fort(global_c_ptr)
51+
use, intrinsic :: iso_c_binding
52+
use global
53+
implicit none
54+
55+
type (C_PTR) :: global_c_ptr
56+
type (global_type), pointer :: gdata
57+
58+
call C_F_POINTER(global_c_ptr, gdata)
59+
call term(gdata)
60+
61+
end subroutine term_fort
62+
63+
subroutine get_neighbors_fort(numneighbors, neighbors, global_c_ptr)
64+
use, intrinsic :: iso_c_binding
65+
use global
66+
implicit none
67+
68+
type (C_PTR) :: global_c_ptr
69+
type (global_type), pointer :: gdata
70+
integer :: numneighbors
71+
integer :: neighbors(MAX_DOMAIN_NEIGHBORS)
72+
73+
call C_F_POINTER(global_c_ptr, gdata)
74+
call get_neighbors(numneighbors, neighbors, gdata)
75+
76+
end subroutine get_neighbors_fort
77+
78+
subroutine get_outgoing_nodes_fort(global_c_ptr, neighbor, num_nodes, alives)
79+
use, intrinsic :: iso_c_binding
80+
use global
81+
implicit none
82+
83+
type (C_PTR) :: global_c_ptr
84+
type (global_type), pointer :: gdata
85+
integer :: neighbor
86+
integer, intent(out) :: num_nodes
87+
integer :: alives(MAX_BOUNDARY_SIZE)
88+
89+
call C_F_POINTER(global_c_ptr, gdata)
90+
91+
call get_outgoing_nodes(gdata, neighbor, num_nodes, alives)
92+
93+
end subroutine get_outgoing_nodes_fort
94+
95+
subroutine put_incoming_nodes_fort(global_c_ptr, neighbor, num_nodes, alives)
96+
use, intrinsic :: iso_c_binding
97+
use global
98+
implicit none
99+
100+
type (C_PTR) :: global_c_ptr
101+
type (global_type), pointer :: gdata
102+
integer :: neighbor
103+
integer :: num_nodes
104+
integer :: alives(MAX_BOUNDARY_SIZE)
105+
106+
call C_F_POINTER(global_c_ptr, gdata)
107+
108+
call put_incoming_nodes(gdata, neighbor, num_nodes, alives)
109+
110+
end subroutine put_incoming_nodes_fort

Diff for: ‎fname.h

+20
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
#ifndef FNAME_H
2+
#define FNAME_H
3+
4+
#if defined(sgi) || defined(SGI) || defined(__sgi__) || defined(__SGI__)
5+
#define FNAME(n_) n_##_
6+
#elif defined(__INTEL_COMPILER)
7+
#define FNAME(n_) n_##_
8+
#elif defined(__GNUC__) && !defined(__INTEL_COMPILER)
9+
#define FNAME(n_) n_##_
10+
#elif defined(__PGI)
11+
#define FNAME(n_) n_##_
12+
#elif defined(_MSC_VER)
13+
#define FNAME(n_) n_
14+
#else
15+
#error "Unknown Fortran name mangling convention"
16+
#endif
17+
18+
#endif
19+
20+

Diff for: ‎global.f95

+10
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
include 'global_data_module.f95'
2+
include 'init.f95'
3+
include 'print.f95'
4+
include 'update.f95'
5+
include 'term.f95'
6+
include 'neighb.f95'
7+
include 'read_fort14.f95'
8+
include 'msg_table.f95'
9+
include 'boundary_exchange.f95'
10+
include 'cwrappers.f95'

Diff for: ‎global_data_module.f95

+102
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,102 @@
1+
module global_data
2+
integer, parameter :: MAX_NEIGHBORS = 10
3+
integer, parameter :: MAX_DOMAIN_NEIGHBORS = 10
4+
integer, parameter :: MAX_BOUNDARY_SIZE = 20
5+
type global_type
6+
integer :: id
7+
integer :: NE, NP
8+
real(8), allocatable, dimension(:) :: X
9+
real(8), allocatable, dimension(:) :: Y
10+
real(8), allocatable, dimension(:) :: DP
11+
integer, allocatable, dimension(:) :: NNEIGH
12+
integer, allocatable, dimension(:,:) :: NEIGH
13+
INTEGER, allocatable, dimension(:,:) :: NM
14+
15+
integer, allocatable, dimension(:) :: ALIVE
16+
integer, allocatable, dimension(:) :: NEW_ALIVE
17+
18+
! IO stuff
19+
CHARACTER*6 :: DIRNAME
20+
INTEGER :: unit18
21+
INTEGER :: unit14
22+
23+
! message passing stuff
24+
INTEGER :: NEIGHPROC
25+
logical, allocatable :: resnode(:)
26+
INTEGER, ALLOCATABLE :: NNODRECV(:),IRECVLOC(:,:)
27+
INTEGER, ALLOCATABLE :: IPROC(:), NNODELOC(:)
28+
INTEGER, ALLOCATABLE :: NNODSEND(:), IBELONGTO(:),ISENDLOC(:,:)
29+
INTEGER, ALLOCATABLE :: ISENDBUF(:,:), IRECVBUF(:,:)
30+
INTEGER, ALLOCATABLE :: INDX(:)
31+
32+
33+
end type global_type
34+
end module global_data
35+
36+
37+
module global
38+
use global_data
39+
40+
interface
41+
subroutine init(id, g)
42+
use global_data
43+
integer :: id
44+
type(global_type), pointer :: g
45+
end subroutine
46+
end interface
47+
48+
interface
49+
subroutine print(g, timestep)
50+
use global_data
51+
type(global_type), pointer :: g
52+
integer :: timestep
53+
end subroutine
54+
end interface
55+
56+
interface
57+
subroutine update(timestep, g)
58+
use global_data
59+
type(global_type), pointer :: g
60+
integer :: timestep
61+
end subroutine
62+
end interface
63+
64+
interface
65+
subroutine term(g)
66+
use global_data
67+
type(global_type), pointer :: g
68+
end subroutine
69+
end interface
70+
71+
interface
72+
subroutine get_neighbors(numneighbors,neighbors,g)
73+
use global_data
74+
type(global_type), pointer :: g
75+
integer :: numneighbors
76+
integer :: neighbors(MAX_DOMAIN_NEIGHBORS)
77+
end subroutine
78+
end interface
79+
80+
interface
81+
subroutine get_outgoing_nodes(g,neighbor,num_nodes,alives)
82+
use global_data
83+
type(global_type), pointer :: g
84+
integer :: neighbor
85+
integer, intent(out) :: num_nodes
86+
integer :: alives(MAX_BOUNDARY_SIZE)
87+
end subroutine
88+
end interface
89+
90+
interface
91+
subroutine put_incoming_nodes(g,neighbor,num_nodes,alives)
92+
use global_data
93+
type(global_type), pointer :: g
94+
integer :: neighbor
95+
integer :: num_nodes
96+
integer :: alives(MAX_BOUNDARY_SIZE)
97+
end subroutine
98+
end interface
99+
100+
end module global
101+
102+

Diff for: ‎init.f95

+31
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
subroutine init(id, g)
2+
use global_data
3+
implicit none
4+
5+
!incoming variable
6+
integer :: id
7+
8+
INTEGER, ALLOCATABLE :: NM(:,:)
9+
type(global_type), pointer :: g
10+
allocate(g)
11+
12+
g%id = id
13+
g%DIRNAME = 'PE0000'
14+
WRITE(g%DIRNAME(3:6),'(I4.4)') g%id
15+
g%unit14 = 200+g%id ! This is experimental! might not be safe
16+
g%unit18 = 500+g%id ! this will definitely break things
17+
! certain file unit numbers are reserved in FORTRAN
18+
19+
call read_fort14(g)
20+
21+
! build neighbor table
22+
call NEIGHB(g)
23+
24+
call msg_table(g)
25+
26+
! Seed single node
27+
if (g%id.eq.0) then
28+
g%NEW_ALIVE(6) = 1
29+
end if
30+
31+
end subroutine init

0 commit comments

Comments
 (0)