GCC Code Coverage Report


Directory: src/
File: src/bindings/fortran/wrappers.f90
Date: 2026-09-15 07:37:49
Exec Total Coverage
Lines: 15 48 31.2%
Functions: 3 9 33.3%
Branches: 0 0 -%

Line Branch Exec Source
1 !-------------------------------------------------------------------------------!
2 ! Copyright 2009-2026 Barcelona Supercomputing Center !
3 ! !
4 ! This file is part of the DLB library. !
5 ! !
6 ! DLB is free software: you can redistribute it and/or modify !
7 ! it under the terms of the GNU Lesser General Public License as published by !
8 ! the Free Software Foundation, either version 3 of the License, or !
9 ! (at your option) any later version. !
10 ! !
11 ! DLB is distributed in the hope that it will be useful, !
12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of !
13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !
14 ! GNU Lesser General Public License for more details. !
15 ! !
16 ! You should have received a copy of the GNU Lesser General Public License !
17 ! along with DLB. If not, see <https://www.gnu.org/licenses/>. !
18 !-------------------------------------------------------------------------------!
19
20
21 2 function dlb_init(ncpus, mask, dlb_args) result (ierr)
22 use :: iso_c_binding
23 use :: mod_string, only: string_f2c
24 implicit none
25 integer(kind=c_int) :: ierr
26 integer(kind=c_int), value, intent(in) :: ncpus
27 type(c_ptr), value, intent(in) :: mask
28 character(len=*), intent(in) :: dlb_args
29
30 4 character(kind=c_char) :: dlb_args_c(len_trim(dlb_args)+1)
31
32 interface
33 function dlb_init_c(ncpus, mask, dlb_args) result (ierr) &
34 & bind(c, name='DLB_Init')
35 use :: iso_c_binding
36 integer(kind=c_int) :: ierr
37 integer(kind=c_int), value, intent(in) :: ncpus
38 type(c_ptr), value, intent(in) :: mask
39 character(kind=c_char), intent(in) :: dlb_args(*)
40 end function dlb_init_c
41 end interface
42
43 2 call string_f2c(dlb_args, dlb_args_c)
44
45 2 ierr = dlb_init_c(ncpus, mask, dlb_args_c)
46
47 4 end function dlb_init
48
49
50 function dlb_barriernamedregister(barrier_name, flags) result (handle)
51 use :: iso_c_binding
52 use :: mod_string, only: string_f2c
53 implicit none
54 type(c_ptr) :: handle
55 character(len=*), intent(in) :: barrier_name
56 integer(kind=c_int), value, intent(in) :: flags
57
58 character(kind=c_char) :: barrier_name_c(len_trim(barrier_name)+1)
59
60 interface
61 function dlb_barriernamedregister_c(barrier_name, flags) &
62 & result (handle) &
63 & bind(c, name='DLB_BarrierNamedRegister')
64 use :: iso_c_binding
65 type(c_ptr) :: handle
66 character(kind=c_char), intent(in) :: barrier_name(*)
67 integer(kind=c_int), value, intent(in) :: flags
68 end function dlb_barriernamedregister_c
69 end interface
70
71 call string_f2c(barrier_name, barrier_name_c)
72
73 handle = dlb_barriernamedregister_c(barrier_name_c, flags)
74
75 end function dlb_barriernamedregister
76
77
78 function dlb_barriernamedget(barrier_name, flags) result (handle)
79 use :: iso_c_binding
80 use :: mod_string, only: string_f2c
81 implicit none
82 type(c_ptr) :: handle
83 character(len=*), intent(in) :: barrier_name
84 integer(kind=c_int), value, intent(in) :: flags
85
86 character(kind=c_char) :: barrier_name_c(len_trim(barrier_name)+1)
87
88 interface
89 function dlb_barriernamedget_c(barrier_name, flags) &
90 & result (handle) &
91 & bind(c, name='DLB_BarrierNamedGet')
92 use :: iso_c_binding
93 type(c_ptr) :: handle
94 character(kind=c_char), intent(in) :: barrier_name(*)
95 integer(kind=c_int), value, intent(in) :: flags
96 end function dlb_barriernamedget_c
97 end interface
98
99 call string_f2c(barrier_name, barrier_name_c)
100
101 handle = dlb_barriernamedget_c(barrier_name_c, flags)
102
103 end function dlb_barriernamedget
104
105
106 function dlb_setvariable(variable, val) result (ierr)
107 use :: iso_c_binding
108 use :: mod_string, only: string_f2c
109 implicit none
110 integer(kind=c_int) :: ierr
111 character(len=*), intent(in) :: variable
112 character(len=*), intent(in) :: val
113
114 character(kind=c_char) :: variable_c(len_trim(variable)+1)
115 character(kind=c_char) :: val_c(len_trim(val)+1)
116
117 interface
118 function dlb_setvariable_c(variable, val) result (ierr) &
119 & bind(c, name='DLB_SetVariable')
120 use :: iso_c_binding
121 integer(kind=c_int) :: ierr
122 character(kind=c_char), intent(in) :: variable(*)
123 character(kind=c_char), intent(in) :: val(*)
124 end function dlb_setvariable_c
125 end interface
126
127 call string_f2c(variable, variable_c)
128 call string_f2c(val, val_c)
129
130 ierr = dlb_setvariable_c(variable_c, val_c)
131
132 end function dlb_setvariable
133
134
135 function dlb_getvariable(variable, val) result (ierr)
136 use :: iso_c_binding
137 use :: mod_string, only: string_c2f, string_f2c
138 implicit none
139 integer(kind=c_int) :: ierr
140 character(len=*), intent(in) :: variable
141 character(len=*), intent(out) :: val
142
143 integer, parameter :: MAX_OPTION_LENGTH = 64
144 character(kind=c_char) :: val_c(MAX_OPTION_LENGTH)
145 character(kind=c_char) :: variable_c(len_trim(variable)+1)
146
147 interface
148 function dlb_getvariable_c(variable, val) result (ierr) &
149 & bind(c, name='DLB_GetVariable')
150 use :: iso_c_binding
151 integer(kind=c_int) :: ierr
152 character(kind=c_char), intent(in) :: variable(*)
153 character(kind=c_char), intent(out) :: val(*)
154 end function dlb_getvariable_c
155 end interface
156
157 call string_f2c(variable, variable_c)
158
159 ierr = dlb_getvariable_c(variable_c, val_c)
160
161 call string_c2f(val_c, val)
162
163 end function dlb_getvariable
164
165
166 1 function dlb_drom_setprocessmaskstr(pid, mask, flags) result (ierr)
167 use :: iso_c_binding
168 use :: mod_string, only: string_f2c
169 implicit none
170 integer(kind=c_int) :: ierr
171 integer(kind=c_int), value, intent(in) :: pid
172 character(len=*), intent(in) :: mask
173 integer(kind=c_int), value, intent(in) :: flags
174
175 2 character(kind=c_char) :: mask_c(len_trim(mask)+1)
176
177 interface
178 function dlb_drom_setprocessmaskstr_c(pid, mask, flags) &
179 & result (ierr) &
180 & bind(c, name='DLB_DROM_SetProcessMaskStr')
181 use :: iso_c_binding
182 integer(kind=c_int) :: ierr
183 integer(kind=c_int), value, intent(in) :: pid
184 character(kind=c_char), intent(in) :: mask(*)
185 integer(kind=c_int), value, intent(in) :: flags
186 end function dlb_drom_setprocessmaskstr_c
187 end interface
188
189 1 call string_f2c(mask, mask_c)
190
191 1 ierr = dlb_drom_setprocessmaskstr_c(pid, mask_c, flags)
192
193 2 end function dlb_drom_setprocessmaskstr
194
195
196 function dlb_mngo_regionregister(region_name, flags) result(handle)
197 use :: iso_c_binding
198 use :: mod_string, only: string_f2c
199 implicit none
200 type(c_ptr) :: handle
201 character(len=*), intent(in) :: region_name
202 integer(kind=c_int), value, intent(in) :: flags
203
204 character(kind=c_char) :: region_name_c(len_trim(region_name)+1)
205
206 interface
207 function dlb_mngo_regionregister_c(region_name, flags) &
208 & result(handle) &
209 & bind(c, name="DLB_MNGO_RegionRegister")
210 use :: iso_c_binding
211 type(c_ptr) :: handle
212 character(kind=c_char), intent(in) :: region_name(*)
213 integer(kind=c_int), value, intent(in) :: flags
214 end function dlb_mngo_regionregister_c
215 end interface
216
217 call string_f2c(region_name, region_name_c)
218
219 handle = dlb_mngo_regionregister_c(region_name_c, flags)
220
221 end function dlb_mngo_regionregister
222
223
224 function dlb_talp_querypopnodemetrics(name, node_metrics) result(ierr)
225 use :: iso_c_binding
226 use :: mod_string, only: string_f2c
227 implicit none
228 include 'dlbf_types.h'
229 integer(kind=c_int) :: ierr
230 character(len=*), intent(in) :: name
231 type(dlb_node_metrics_t), intent(out) :: node_metrics
232
233 character(kind=c_char) :: name_c(len_trim(name)+1)
234
235 interface
236 function dlb_talp_querypopnodemetrics_c(name, node_metrics) &
237 result(ierr) &
238 bind(c, name='DLB_TALP_QueryPOPNodeMetrics')
239 use :: iso_c_binding
240 import :: dlb_node_metrics_t
241 integer(kind=c_int) :: ierr
242 character(kind=c_char), intent(in) :: name(*)
243 type(dlb_node_metrics_t), intent(out) :: node_metrics
244 end function dlb_talp_querypopnodemetrics_c
245 end interface
246
247 call string_f2c(name, name_c)
248
249 ierr = dlb_talp_querypopnodemetrics_c(name_c, node_metrics)
250
251 end function dlb_talp_querypopnodemetrics
252
253
254 3 function dlb_monitoringregionregister(region_name) result (handle)
255 use :: iso_c_binding
256 use :: mod_string, only: string_f2c
257 implicit none
258 type(c_ptr) :: handle
259 character(len=*), intent(in) :: region_name
260
261 6 character(kind=c_char) :: region_name_c(len_trim(region_name)+1)
262
263 interface
264 function dlb_monitoringregionregister_c(region_name) &
265 & result (handle) &
266 & bind(c, name='DLB_MonitoringRegionRegister')
267 use :: iso_c_binding
268 type(c_ptr) :: handle
269 character(kind=c_char), intent(in) :: region_name(*)
270 end function dlb_monitoringregionregister_c
271 end interface
272
273 3 call string_f2c(region_name, region_name_c)
274
275 3 handle = dlb_monitoringregionregister_c(region_name_c)
276
277 6 end function dlb_monitoringregionregister
278