Line data Source code
1 : !!****m* ABINIT/m_xpapi
2 : !! NAME
3 : !! m_xpapi
4 : !!
5 : !! FUNCTION
6 : !! Thin wrapper for the PAPI library.
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 2009-2026 ABINIT group (MG,DC)
10 : !! This file is distributed under the terms of the
11 : !! GNU General Public License, see ~abinit/COPYING
12 : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : !!
14 :
15 : #if defined HAVE_CONFIG_H
16 : #include "config.h"
17 : #endif
18 :
19 : #include "abi_common.h"
20 :
21 : MODULE m_xpapi
22 :
23 : use defs_basis
24 : use m_errors
25 : use, intrinsic :: iso_c_binding
26 :
27 : implicit none
28 :
29 : private
30 :
31 : #ifdef HAVE_PAPI
32 : #include "f90papi.h"
33 : #endif
34 :
35 : public :: xpapi_init
36 : public :: xpapi_show_info
37 : public :: xpapi_flops
38 : public :: xpapi_shutdown
39 : !!***
40 :
41 : !----------------------------------------------------------------------
42 :
43 : CONTAINS !===========================================================
44 : !!***
45 :
46 : !!****f* m_xpapi/xpapi_init
47 : !! NAME
48 : !! xpapi_init
49 : !!
50 : !! FUNCTION
51 : !! initialize the PAPI library. It must be called before any low level PAPI functions can be used.
52 : !! If your application is making use of threads PAPI_thread_init (3) also be called prior to making
53 : !! any calls to the library other than PAPI_library_init().
54 : !!
55 : !! SOURCE
56 :
57 1440 : subroutine xpapi_init()
58 :
59 : #ifdef HAVE_PAPI
60 : !Local variables-------------------------------
61 : character(len=PAPI_MAX_STR_LEN) :: papi_errstr
62 : integer(C_INT) :: check
63 : real(C_FLOAT) :: real_time,proc_time,mflops
64 : integer(C_LONG_LONG) :: flpops
65 :
66 : ! *************************************************************************
67 :
68 : check = PAPI_VER_CURRENT
69 : call PAPIf_library_init(check)
70 :
71 : if ( check /= PAPI_VER_CURRENT .and. check >0 ) then
72 : ABI_WARNING(" PAPI library version mismatch!")
73 : end if
74 : !ABI_CHECK(check>=0," PAPI Initialization error!")
75 : !XPAPI_CHECK(check," PAPI Initialization error!")
76 :
77 : !#ifdef HAVE_OPENMP
78 : !call PAPIf_thread_init(pthread_self, check)
79 : !XPAPI_CHECK(check>=0," PAPIf_thread_init")
80 : !#endif
81 :
82 : ! First pass. Set up counters to monitor PAPI_FP_OPS and PAPI_TOT_CYC events and start the counters
83 : ! Subsequent calls will read the counters and return total real time,
84 : ! total process time, total floting point instructions or operations
85 : ! since the start of the mesurement and the Mflop/s rate since latests call to PAPI_flops
86 : call PAPIf_flops(real_time, proc_time, flpops, mflops, check)
87 : XPAPI_CHECK(check,"Problem in PAPIf_flops")
88 :
89 : #endif
90 :
91 1440 : end subroutine xpapi_init
92 : !!***
93 :
94 : !----------------------------------------------------------------------
95 :
96 : !!****f* m_xpapi/xpapi_show_info
97 : !! NAME
98 : !! xpapi_show_info
99 : !!
100 : !! FUNCTION
101 : !!
102 : !! INPUTS
103 : !! [unit]=unit number for writing. The named constant dev_null defined in defs_basis can be used to avoid any printing.
104 : !! Default = std_out
105 : !! [mode_paral]= --optional argument--
106 : !! 'COLL' if all procs are calling the routine with the same message to be written once only. Default.
107 : !! 'PERS' if the procs are calling the routine with different messages each to be written,
108 : !! or if one proc is calling the routine: DEFAULT = "COLL"
109 : !!
110 : !! SOURCE
111 :
112 1440 : subroutine xpapi_show_info(unit,mode_paral)
113 :
114 : !Arguments-------------------------
115 : integer,optional,intent(in) :: unit
116 : character(len=*),optional,intent(in) :: mode_paral
117 :
118 : !Local variables-------------------
119 : #ifdef HAVE_PAPI
120 : integer :: unt
121 : integer(C_INT) :: num_hwcntrs,ncpu,nnodes,totalcpus,vendor,model
122 : real(C_FLOAT) :: revision,mhz
123 : character(len=PAPI_MAX_STR_LEN) :: vendor_string,model_string
124 : character(len=500) :: msg,my_mode
125 : #endif
126 :
127 : ! *************************************************************************
128 :
129 : #ifdef HAVE_PAPI
130 : unt = std_out; if (PRESENT(unit)) unt = unit
131 : my_mode = "COLL"; if (PRESENT(mode_paral)) my_mode = mode_paral
132 :
133 : call PAPIf_num_counters(num_hwcntrs)
134 : if (num_hwcntrs < 0) then
135 : ABI_WARNING(" The installation does not support PAPI")
136 : end if
137 :
138 : if (num_hwcntrs == 0) then
139 : msg = " The installation supports PAPI, but this machine does not provide hardware counters."
140 : ABI_WARNING(msg)
141 : end if
142 :
143 : call PAPIF_get_hardware_info (ncpu,nnodes,totalcpus,vendor,vendor_string,model,model_string,revision,mhz)
144 :
145 : write(msg,"(a,i0)")" PAPI Version ",PAPI_VER_CURRENT
146 : call wrtout(unt,msg,my_mode)
147 : write(msg,"(a,i0)")" Number of hardware counters: ",num_hwcntrs
148 : call wrtout(unt,msg,my_mode)
149 : write(msg,"(a,i0)")" Number of CPUs in an SMP Node: ",ncpu
150 : call wrtout(unt,msg,my_mode)
151 : write(msg,"(a,i0)")" Number of nodes in the entire system: ",nnodes
152 : call wrtout(unt,msg,my_mode)
153 : write(msg,"(a,i0)")" Total number of CPUs in the entire system: ",totalcpus
154 : call wrtout(unt,msg,my_mode)
155 : !write(msg,"(a,i0)")" Vendor id number of CPU: ",vendor
156 : !call wrtout(unt,msg,my_mode)
157 : !write(msg,"(a)") " Vendor id string of CPU: "//TRIM(vendor_string)
158 : !call wrtout(unt,msg,my_mode)
159 : !write(msg,"(a,i0)")" Model number of CPU: ",model
160 : !call wrtout(unt,msg,my_mode)
161 : write(msg,"(a)") " Model string of CPU: "//TRIM(model_string)
162 : !call wrtout(unt,msg,my_mode)
163 : !write(msg,"(a,f5.1)")" Revision number of CPU: ",revision
164 : !write(msg,"(a,f8.2")" Cycle time of this CPU; *may* be an estimate generated at init time with a quick timing routine",mhz
165 :
166 : #else
167 : ABI_UNUSED(mode_paral)
168 : ABI_UNUSED(unit)
169 : #endif
170 :
171 1440 : end subroutine xpapi_show_info
172 : !!***
173 :
174 : !----------------------------------------------------------------------
175 :
176 : !!****f* m_xpapi/xpapi_flops
177 : !! NAME
178 : !! xpapi_flops
179 : !!
180 : !! FUNCTION
181 : !! PAPI High Level: Simplified call to get Mflops/s, real and processor time
182 : !!
183 : !! OUTPUT
184 : !! real_time -- total realtime since the first PAPI_flops() call
185 : !! proc_time -- total process time since the first PAPI_flops() call
186 : !! flops -- total floating point instructions or operations since the first call
187 : !! mflops -- Mflop/s achieved since the previous call
188 : !! check = exit status
189 : !!
190 : !! SOURCE
191 :
192 0 : subroutine xpapi_flops(real_time,proc_time,flops,mflops,check)
193 :
194 : !Arguments-------------------------
195 : integer(C_INT),intent(out) :: check
196 : integer(C_LONG_LONG),intent(out) :: flops
197 : real(C_FLOAT),intent(out) :: real_time,proc_time,mflops
198 :
199 : ! *************************************************************************
200 :
201 : #ifdef HAVE_PAPI
202 : call PAPIf_flops(real_time, proc_time, flops, mflops, check)
203 : #endif
204 :
205 0 : end subroutine xpapi_flops
206 : !!***
207 :
208 : !----------------------------------------------------------------------
209 :
210 : !!****f* m_xpapi/xpapi_shutdown
211 : !! NAME
212 : !! xpapi_shutdown
213 : !!
214 : !! FUNCTION
215 : !! exit function used by the PAPI Library to free resources and shut down when certain error conditions arise.
216 : !!
217 : !! SOURCE
218 :
219 1426 : subroutine xpapi_shutdown()
220 :
221 : ! *************************************************************************
222 :
223 : #ifdef HAVE_PAPI
224 : call PAPIf_shutdown()
225 : #endif
226 :
227 1426 : end subroutine xpapi_shutdown
228 : !!***
229 :
230 : !----------------------------------------------------------------------
231 :
232 : !!****f* m_xpapi/xpapi_handle_error
233 : !! NAME
234 : !! xpapi_handle_error
235 : !!
236 : !! FUNCTION
237 : !!
238 : !! SOURCE
239 :
240 : subroutine xpapi_handle_error(check,err_msg,file,line)
241 :
242 : !Arguments ------------------------------------
243 : !scalars
244 : integer(C_INT),intent(in) :: check
245 : integer,optional,intent(in) :: line
246 : character(len=*),intent(in) :: err_msg
247 : character(len=*),optional,intent(in) :: file
248 :
249 : !Local variables-------------------------------
250 : integer :: f90line
251 : character(len=10) :: lnum
252 : character(len=500) :: f90name
253 : character(len=500) :: my_msg
254 : #ifdef HAVE_PAPI
255 : integer(C_INT) :: ierr,ans
256 : character(len=PAPI_MAX_STR_LEN) :: papi_errstr
257 : #endif
258 :
259 : ! *************************************************************************
260 :
261 : if (PRESENT(line)) then
262 : f90line=line
263 : else
264 : f90line=0
265 : end if
266 : write(lnum,'(i0)')f90line
267 :
268 : if (PRESENT(file)) then
269 : !f90name = basename(file)
270 : f90name = file
271 : else
272 : f90name='Subroutine Unknown'
273 : end if
274 :
275 : my_msg=TRIM(f90name)//":"//TRIM(lnum)//":"
276 :
277 : #ifdef HAVE_PAPI
278 : if (check /= PAPI_OK) then
279 : write(std_out,*) " Error in papi library at: "//TRIM(my_msg)
280 : write(std_out,*) " User message: "//TRIM(err_msg)
281 : call PAPIF_is_initialized(ans)
282 : if (ans == PAPI_LOW_LEVEL_INITED) then
283 : call papif_perror(check,papi_errstr,ierr)
284 : write(std_out,*) 'Error code: ',TRIM(papi_errstr)
285 : else
286 : write(std_out,*) "Papi library is not initialized!"
287 : end if
288 : end if
289 : ABI_ERROR("Fatal error")
290 : #else
291 : ABI_UNUSED(err_msg)
292 : if (.FALSE.) write(std_out,*) check
293 : #endif
294 :
295 : end subroutine xpapi_handle_error
296 : !!***
297 :
298 : END MODULE m_xpapi
299 : !!***
|
