14 #include "../base/base_uses.f90"
18 PUBLIC :: mp_perf_env_type
24 CHARACTER(LEN=20) :: name =
""
26 REAL(KIND=
dp) :: msg_size = 0.0_dp
29 INTEGER,
PARAMETER :: MAX_PERF = 28
34 INTEGER :: ref_count = -1
35 TYPE(mp_perf_type),
DIMENSION(MAX_PERF) :: mp_perfs = mp_perf_type()
38 END TYPE mp_perf_env_type
41 TYPE mp_perf_env_p_type
42 TYPE(mp_perf_env_type),
POINTER :: mp_perf_env => null()
43 END TYPE mp_perf_env_p_type
46 INTEGER,
PARAMETER :: max_stack_size = 10
47 INTEGER :: stack_pointer = 0
48 TYPE(mp_perf_env_p_type),
DIMENSION(max_stack_size),
SAVE :: mp_perf_stack
50 CHARACTER(LEN=20),
PARAMETER :: sname(MAX_PERF) = &
51 (/
"MP_Group ",
"MP_Bcast ",
"MP_Allreduce ", &
52 "MP_Gather ",
"MP_Sync ",
"MP_Alltoall ", &
53 "MP_SendRecv ",
"MP_ISendRecv ",
"MP_Wait ", &
54 "MP_comm_split ",
"MP_ISend ",
"MP_IRecv ", &
55 "MP_Send ",
"MP_Recv ",
"MP_Memory ", &
56 "MP_Put ",
"MP_Get ",
"MP_Fence ", &
57 "MP_Win_Lock ",
"MP_Win_Create ",
"MP_Win_Free ", &
58 "MP_IBcast ",
"MP_IAllreduce ",
"MP_IScatter ", &
59 "MP_RGet ",
"MP_Isync ",
"MP_Read_All ", &
76 TYPE(mp_perf_env_type),
OPTIONAL,
POINTER :: perf_env
78 stack_pointer = stack_pointer + 1
79 IF (stack_pointer > max_stack_size)
THEN
80 cpabort(
"stack_pointer too large : message_passing @ add_mp_perf_env")
82 NULLIFY (mp_perf_stack(stack_pointer)%mp_perf_env)
83 IF (
PRESENT(perf_env))
THEN
84 mp_perf_stack(stack_pointer)%mp_perf_env => perf_env
87 IF (.NOT.
ASSOCIATED(mp_perf_stack(stack_pointer)%mp_perf_env))
THEN
88 CALL mp_perf_env_create(mp_perf_stack(stack_pointer)%mp_perf_env)
96 SUBROUTINE mp_perf_env_create(perf_env)
97 TYPE(mp_perf_env_type),
OPTIONAL,
POINTER :: perf_env
103 perf_env%ref_count = 1
105 perf_env%mp_perfs(i)%name = sname(i)
108 END SUBROUTINE mp_perf_env_create
115 TYPE(mp_perf_env_type),
POINTER :: perf_env
117 IF (
ASSOCIATED(perf_env))
THEN
118 IF (perf_env%ref_count < 1)
THEN
119 cpabort(
"invalid ref_count: message_passing @ mp_perf_env_release")
121 perf_env%ref_count = perf_env%ref_count - 1
122 IF (perf_env%ref_count == 0)
THEN
123 DEALLOCATE (perf_env)
134 CLASS(mp_perf_env_type),
INTENT(INOUT) :: perf_env
136 perf_env%ref_count = perf_env%ref_count + 1
145 SUBROUTINE mp_perf_env_describe(perf_env, iw)
146 TYPE(mp_perf_env_type),
INTENT(IN) :: perf_env
147 INTEGER,
INTENT(IN) :: iw
149 #if defined(__parallel)
154 IF (perf_env%ref_count < 1)
THEN
155 cpabort(
"invalid perf_env%ref_count : message_passing @ mp_perf_env_describe")
157 #if defined(__parallel)
159 WRITE (iw,
'( /, 1X, 79("-") )')
160 WRITE (iw,
'( " -", 77X, "-" )')
161 WRITE (iw,
'( " -", 24X, A, 24X, "-" )')
' MESSAGE PASSING PERFORMANCE '
162 WRITE (iw,
'( " -", 77X, "-" )')
163 WRITE (iw,
'( 1X, 79("-"), / )')
164 WRITE (iw,
'( A, A, A )')
' ROUTINE',
' CALLS ', &
165 ' AVE VOLUME [Bytes]'
168 IF (perf_env%mp_perfs(i)%count > 0)
THEN
169 vol = perf_env%mp_perfs(i)%msg_size/real(perf_env%mp_perfs(i)%count, kind=
dp)
170 IF (vol < 1.0_dp)
THEN
171 WRITE (iw,
'(1X,A15,T17,I10)') &
172 adjustl(perf_env%mp_perfs(i)%name), perf_env%mp_perfs(i)%count
174 WRITE (iw,
'(1X,A15,T17,I10,T40,F11.0)') &
175 adjustl(perf_env%mp_perfs(i)%name), perf_env%mp_perfs(i)%count, &
181 WRITE (iw,
'( 1X, 79("-"), / )')
186 END SUBROUTINE mp_perf_env_describe
192 IF (stack_pointer < 1)
THEN
193 cpabort(
"no perf_env in the stack : message_passing @ rm_mp_perf_env")
196 stack_pointer = stack_pointer - 1
204 TYPE(mp_perf_env_type),
POINTER :: res
206 IF (stack_pointer < 1)
THEN
207 cpabort(
"no perf_env in the stack : message_passing @ get_mp_perf_env")
209 res => mp_perf_stack(stack_pointer)%mp_perf_env
217 INTEGER,
INTENT(in) :: scr
219 TYPE(mp_perf_env_type),
POINTER :: perf_env
222 CALL mp_perf_env_describe(perf_env, scr)
233 INTEGER,
INTENT(in) :: perf_id
234 INTEGER,
INTENT(in),
OPTIONAL :: count
235 INTEGER,
INTENT(in),
OPTIONAL :: msg_size
237 #if defined(__parallel)
238 TYPE(mp_perf_type),
POINTER :: mp_perf
240 IF (.NOT.
ASSOCIATED(mp_perf_stack(stack_pointer)%mp_perf_env))
RETURN
242 mp_perf => mp_perf_stack(stack_pointer)%mp_perf_env%mp_perfs(perf_id)
243 IF (
PRESENT(count))
THEN
244 mp_perf%count = mp_perf%count + count
246 IF (
PRESENT(msg_size))
THEN
247 mp_perf%msg_size = mp_perf%msg_size + real(msg_size,
dp)
Defines the basic variable types.
integer, parameter, public dp
Defines all routines to deal with the performance of MPI routines.
subroutine, public mp_perf_env_release(perf_env)
...
subroutine, public rm_mp_perf_env()
...
subroutine, public describe_mp_perf_env(scr)
...
type(mp_perf_env_type) function, pointer, public get_mp_perf_env()
...
elemental subroutine, public mp_perf_env_retain(perf_env)
...
subroutine, public add_perf(perf_id, count, msg_size)
adds the performance informations of one call
subroutine, public add_mp_perf_env(perf_env)
start and stop the performance indicators for every call to start there has to be (exactly) one call ...