forked from open-atmos/PyPartMC
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathbin_grid.F90
120 lines (94 loc) · 4.25 KB
/
bin_grid.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
!###################################################################################################
! This file is a part of PyPartMC licensed under the GNU General Public License v3 (LICENSE file) #
! Copyright (C) 2022 University of Illinois Urbana-Champaign #
! Authors: https://github.com/open-atmos/PyPartMC/graphs/contributors #
!###################################################################################################
module PyPartMC_bin_grid
use iso_c_binding
use pmc_bin_grid
implicit none
contains
subroutine f_bin_grid_ctor(ptr_c) bind(C)
type(bin_grid_t), pointer :: ptr_f => null()
type(c_ptr), intent(out) :: ptr_c
allocate(ptr_f)
ptr_c = c_loc(ptr_f)
end subroutine
subroutine f_bin_grid_dtor(ptr_c) bind(C)
type(bin_grid_t), pointer :: ptr_f => null()
type(c_ptr), intent(in) :: ptr_c
call c_f_pointer(ptr_c, ptr_f)
deallocate(ptr_f)
end subroutine
subroutine f_bin_grid_init(ptr_c, n_bin, bin_grid_type, min, max) bind(C)
type(c_ptr), intent(in) :: ptr_c
type(bin_grid_t), pointer :: bin_grid => null()
integer(c_int), intent(in) :: n_bin
integer(c_int), intent(in) :: bin_grid_type
real(c_double), intent(in) :: min
real(c_double), intent(in) :: max
call c_f_pointer(ptr_c, bin_grid)
call bin_grid_make(bin_grid, bin_grid_type, n_bin, min, max)
end subroutine
subroutine f_bin_grid_size(ptr_c, val) bind(C)
type(c_ptr), intent(in) :: ptr_c
type(bin_grid_t), pointer :: bin_grid => null()
integer(c_int), intent(out) :: val
call c_f_pointer(ptr_c, bin_grid)
val = bin_grid_size(bin_grid)
end subroutine
subroutine f_bin_grid_edges(ptr_c, arr_data, arr_size) bind(C)
type(c_ptr), intent(in) :: ptr_c
type(bin_grid_t), pointer :: bin_grid => null()
integer(c_int), intent(in) :: arr_size
real(c_double), dimension(arr_size), intent(out) :: arr_data
call c_f_pointer(ptr_c, bin_grid)
arr_data = bin_grid%edges
end subroutine
subroutine f_bin_grid_centers(ptr_c, arr_data, arr_size) bind(C)
type(c_ptr), intent(in) :: ptr_c
type(bin_grid_t), pointer :: bin_grid => null()
integer(c_int), intent(in) :: arr_size
real(c_double), dimension(arr_size), intent(out) :: arr_data
call c_f_pointer(ptr_c, bin_grid)
arr_data = bin_grid%centers
end subroutine
subroutine f_bin_grid_histogram_1d(x_bin_grid_ptr_c, x_data, weight_data, &
arr_size, output_data, bin_grid_size) bind(C)
type(c_ptr), intent(in) :: x_bin_grid_ptr_c
type(bin_grid_t), pointer :: bin_grid => null()
integer(c_int), intent(in) :: arr_size
integer(c_int), intent(in) :: bin_grid_size
real(c_double), dimension(bin_grid_size) :: output_data
real(c_double), dimension(arr_size) :: x_data
real(c_double), dimension(arr_size) :: weight_data
call c_f_pointer(x_bin_grid_ptr_c, bin_grid)
output_data = bin_grid_histogram_1d(bin_grid, x_data, weight_data)
end subroutine
subroutine f_bin_grid_histogram_2d(x_bin_grid_ptr_c, x_data, &
y_bin_grid_ptr_c, y_data, weight_data, &
arr_size, output_data, x_bin_grid_size, y_bin_grid_size) bind(C)
type(c_ptr), intent(in) :: x_bin_grid_ptr_c
type(c_ptr), intent(in) :: y_bin_grid_ptr_c
type(bin_grid_t), pointer :: x_bin_grid => null()
type(bin_grid_t), pointer :: y_bin_grid => null()
integer(c_int), intent(in) :: arr_size
integer(c_int), intent(in) :: x_bin_grid_size
integer(c_int), intent(in) :: y_bin_grid_size
real(c_double), dimension(x_bin_grid_size*y_bin_grid_size), intent(out) :: output_data
real(c_double), dimension(arr_size), intent(in) :: x_data, y_data
real(c_double), dimension(arr_size), intent(in) :: weight_data
real(c_double), allocatable :: output_data_local(:,:)
integer :: i, j
call c_f_pointer(x_bin_grid_ptr_c, x_bin_grid)
call c_f_pointer(y_bin_grid_ptr_c, y_bin_grid)
allocate(output_data_local(x_bin_grid_size,y_bin_grid_size))
output_data_local = bin_grid_histogram_2d(x_bin_grid, x_data, y_bin_grid, &
y_data, weight_data)
do i = 1,x_bin_grid_size
do j = 1,y_bin_grid_size
output_data((i-1)*y_bin_grid_size + j) = output_data_local(i,j)
end do
end do
end subroutine
end module