xref: /petsc/src/sys/tutorials/ex3f90.F90 (revision a336c15037c72f93cd561f5a5e11e93175f2efd9)
1!
2!
3!   Description: Demonstrates how users can augment the PETSc profiling by
4!                inserting their own event logging.
5!
6#include <petsc/finclude/petscsys.h>
7#include <petsc/finclude/petsclog.h>
8program SchoolDay
9  use petscsys
10  implicit none
11
12  ! Settings:
13  integer, parameter        :: verbose = 0               ! 0: silent, >=1 : increasing amount of debugging output
14  integer4, parameter       :: msgLen = 30             ! number of reals which is sent with MPI_Isend
15  PetscReal, parameter      :: second = 0.1             ! time is sped up by a factor 10
16
17  ! Codes
18  integer, parameter        :: BOY = 1, GIRL = 2, TEACHER = 0
19  PetscMPIInt, parameter    :: tagMsg = 1200
20
21  ! Timers
22  PetscLogEvent :: Morning, Afternoon
23  PetscLogEvent :: PlayBall, SkipRope
24  PetscLogEvent :: TidyClass
25  PetscLogEvent :: Lessons, CorrectHomework
26  PetscClassId classid
27
28  ! Petsc-stuff
29  PetscErrorCode            :: ierr
30
31  ! MPI-stuff
32  PetscMPIInt              :: rank, size
33  PetscReal, allocatable    :: message(:, :)
34  integer                   :: item
35  PetscMPIInt :: maxItem
36#if defined(PETSC_USE_MPI_F08)
37  MPIU_Status                  :: status
38#else
39  MPIU_Status                  :: status(MPI_STATUS_SIZE)
40#endif
41  MPIU_Request req
42
43  ! Own stuff
44  integer4                  :: role                 ! is this process a BOY, a GIRL or a TEACHER?
45  integer4                  :: i, j
46
47!     Initializations
48  PetscCallA(PetscInitialize(ierr))
49  PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD, size, ierr))
50  PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
51
52  if (rank == 0) then
53    role = TEACHER
54  else if (rank < 0.4_PETSC_REAL_KIND*size) then
55    role = GIRL
56  else
57    role = BOY
58  end if
59
60  allocate (message(msgLen, msglen))
61  do i = 1, msgLen
62    do j = 1, msgLen
63      message(i, j) = 10.0_PETSC_REAL_KIND*j + i*1.0_PETSC_REAL_KIND/(rank + 1_PETSC_MPIINT_KIND)
64    end do
65  end do
66!
67!     Create new user-defined events
68  classid = 0
69  PetscCallA(PetscLogEventRegister('Morning', classid, Morning, ierr))
70  PetscCallA(PetscLogEventRegister('Afternoon', classid, Afternoon, ierr))
71  PetscCallA(PetscLogEventRegister('Play Ball', classid, PlayBall, ierr))
72  PetscCallA(PetscLogEventRegister('Skip Rope', classid, SkipRope, ierr))
73  PetscCallA(PetscLogEventRegister('Tidy Classroom', classid, TidyClass, ierr))
74  PetscCallA(PetscLogEventRegister('Lessons', classid, Lessons, ierr))
75  PetscCallA(PetscLogEventRegister('Correct Homework', classid, CorrectHomework, ierr))
76  if (verbose >= 1) then
77    print '(a,i0,a)', '[', rank, '] SchoolDay events have been defined'
78  end if
79
80!     Go through the school day
81  PetscCallA(PetscLogEventBegin(Morning, ierr))
82
83  PetscCallA(PetscLogFlops(190000d0, ierr))
84  PetscCallA(PetscSleep(0.5*second, ierr))
85
86  PetscCallA(PetscLogEventBegin(Lessons, ierr))
87  PetscCallA(PetscLogFlops(23000d0, ierr))
88  PetscCallA(PetscSleep(1*second, ierr))
89  if (size > 1) then
90    PetscCallMPIA(MPI_Isend(message, msgLen, MPIU_REAL, mod(rank + 1_PETSC_MPIINT_KIND, size), tagMsg + rank, PETSC_COMM_WORLD, req, ierr))
91    PetscCallMPIA(MPI_Recv(message, msgLen, MPIU_REAL, mod(rank - 1_PETSC_MPIINT_KIND + size, size), tagMsg + mod(rank - 1_PETSC_MPIINT_KIND + size, size), PETSC_COMM_WORLD, status, ierr))
92    PetscCallMPIA(MPI_Wait(req, MPI_STATUS_IGNORE, ierr))
93  end if
94  PetscCallA(PetscLogEventEnd(Lessons, ierr))
95
96  if (role == TEACHER) then
97    PetscCallA(PetscLogEventBegin(TidyClass, ierr))
98    PetscCallA(PetscLogFlops(600000d0, ierr))
99    PetscCallA(PetscSleep(0.6*second, ierr))
100    PetscCallA(PetscLogEventBegin(CorrectHomework, ierr))
101    PetscCallA(PetscLogFlops(234700d0, ierr))
102    PetscCallA(PetscSleep(0.4*second, ierr))
103    PetscCallA(PetscLogEventEnd(CorrectHomework, ierr))
104    PetscCallA(PetscLogEventEnd(TidyClass, ierr))
105  else if (role == BOY) then
106    PetscCallA(PetscLogEventBegin(SkipRope, ierr))
107    PetscCallA(PetscSleep(0.8*second, ierr))
108    PetscCallA(PetscLogEventEnd(SkipRope, ierr))
109  else
110    PetscCallA(PetscLogEventBegin(PlayBall, ierr))
111    PetscCallA(PetscSleep(0.9*second, ierr))
112    PetscCallA(PetscLogEventEnd(PlayBall, ierr))
113  end if
114
115  PetscCallA(PetscLogEventBegin(Lessons, ierr))
116  PetscCallA(PetscLogFlops(120000d0, ierr))
117  PetscCallA(PetscSleep(0.7*second, ierr))
118  PetscCallA(PetscLogEventEnd(Lessons, ierr))
119
120  PetscCallA(PetscLogEventEnd(Morning, ierr))
121
122  PetscCallA(PetscLogEventBegin(Afternoon, ierr))
123
124  item = rank*(3 - rank)
125  PetscCallMPIA(MPI_Allreduce(item, maxItem, 1_PETSC_MPIINT_KIND, MPI_INTEGER, MPI_MAX, PETSC_COMM_WORLD, ierr))
126
127  item = rank*(10 - rank)
128  PetscCallMPIA(MPI_Allreduce(item, maxItem, 1_PETSC_MPIINT_KIND, MPI_INTEGER, MPI_MAX, PETSC_COMM_WORLD, ierr))
129
130  PetscCallA(PetscLogFlops(58988d0, ierr))
131  PetscCallA(PetscSleep(0.6*second, ierr))
132
133  PetscCallA(PetscLogEventBegin(Lessons, ierr))
134  PetscCallA(PetscLogFlops(123456d0, ierr))
135  PetscCallA(PetscSleep(1*second, ierr))
136  PetscCallA(PetscLogEventEnd(Lessons, ierr))
137
138  if (role == TEACHER) then
139    PetscCallA(PetscLogEventBegin(TidyClass, ierr))
140    PetscCallA(PetscLogFlops(17800d0, ierr))
141    PetscCallA(PetscSleep(1.1*second, ierr))
142    PetscCallA(PetscLogEventBegin(Lessons, ierr))
143    PetscCallA(PetscLogFlops(72344d0, ierr))
144    PetscCallA(PetscSleep(0.5*second, ierr))
145    PetscCallA(PetscLogEventEnd(Lessons, ierr))
146    PetscCallA(PetscLogEventEnd(TidyClass, ierr))
147  else if (role == GIRL) then
148    PetscCallA(PetscLogEventBegin(SkipRope, ierr))
149    PetscCallA(PetscSleep(0.7*second, ierr))
150    PetscCallA(PetscLogEventEnd(SkipRope, ierr))
151  else
152    PetscCallA(PetscLogEventBegin(PlayBall, ierr))
153    PetscCallA(PetscSleep(0.8*second, ierr))
154    PetscCallA(PetscLogEventEnd(PlayBall, ierr))
155  end if
156
157  PetscCallA(PetscLogEventBegin(Lessons, ierr))
158  PetscCallA(PetscLogFlops(72344d0, ierr))
159  PetscCallA(PetscSleep(0.5*second, ierr))
160  PetscCallA(PetscLogEventEnd(Lessons, ierr))
161
162  PetscCallA(PetscLogEventEnd(Afternoon, ierr))
163
164  if (.false.) then
165    continue
166  else if (role == TEACHER) then
167    PetscCallA(PetscLogEventBegin(TidyClass, ierr))
168    PetscCallA(PetscLogFlops(612300d0, ierr))
169    PetscCallA(PetscSleep(1.1*second, ierr))
170    PetscCallA(PetscLogEventEnd(TidyClass, ierr))
171    PetscCallA(PetscLogEventBegin(CorrectHomework, ierr))
172    PetscCallA(PetscLogFlops(234700d0, ierr))
173    PetscCallA(PetscSleep(1.1*second, ierr))
174    PetscCallA(PetscLogEventEnd(CorrectHomework, ierr))
175  else
176    PetscCallA(PetscLogEventBegin(SkipRope, ierr))
177    PetscCallA(PetscSleep(0.7*second, ierr))
178    PetscCallA(PetscLogEventEnd(SkipRope, ierr))
179    PetscCallA(PetscLogEventBegin(PlayBall, ierr))
180    PetscCallA(PetscSleep(0.8*second, ierr))
181    PetscCallA(PetscLogEventEnd(PlayBall, ierr))
182  end if
183
184  PetscCallA(PetscLogEventBegin(Lessons, ierr))
185  PetscCallA(PetscLogFlops(120000d0, ierr))
186  PetscCallA(PetscSleep(0.7*second, ierr))
187  PetscCallA(PetscLogEventEnd(Lessons, ierr))
188
189  PetscCallA(PetscSleep(0.25*second, ierr))
190
191  PetscCallA(PetscLogEventBegin(Morning, ierr))
192
193  PetscCallA(PetscLogFlops(190000d0, ierr))
194  PetscCallA(PetscSleep(0.5*second, ierr))
195
196  PetscCallA(PetscLogEventBegin(Lessons, ierr))
197  PetscCallA(PetscLogFlops(23000d0, ierr))
198  PetscCallA(PetscSleep(1*second, ierr))
199  if (size > 1) then
200    PetscCallMPIA(MPI_Isend(message, msgLen, MPIU_REAL, mod(rank + 1_PETSC_MPIINT_KIND, size), tagMsg + rank, PETSC_COMM_WORLD, req, ierr))
201    PetscCallMPIA(MPI_Recv(message, msgLen, MPIU_REAL, mod(rank - 1_PETSC_MPIINT_KIND + size, size), tagMsg + mod(rank - 1_PETSC_MPIINT_KIND + size, size), PETSC_COMM_WORLD, status, ierr))
202    PetscCallMPIA(MPI_Wait(req, MPI_STATUS_IGNORE, ierr))
203  end if
204  PetscCallA(PetscLogEventEnd(Lessons, ierr))
205
206  if (role == TEACHER) then
207    PetscCallA(PetscLogEventBegin(TidyClass, ierr))
208    PetscCallA(PetscLogFlops(600000d0, ierr))
209    PetscCallA(PetscSleep(1.2*second, ierr))
210    PetscCallA(PetscLogEventEnd(TidyClass, ierr))
211  else if (role == BOY) then
212    PetscCallA(PetscLogEventBegin(SkipRope, ierr))
213    PetscCallA(PetscSleep(0.8*second, ierr))
214    PetscCallA(PetscLogEventEnd(SkipRope, ierr))
215  else
216    PetscCallA(PetscLogEventBegin(PlayBall, ierr))
217    PetscCallA(PetscSleep(0.9*second, ierr))
218    PetscCallA(PetscLogEventEnd(PlayBall, ierr))
219  end if
220
221  PetscCallA(PetscLogEventBegin(Lessons, ierr))
222  PetscCallA(PetscLogFlops(120000d0, ierr))
223  PetscCallA(PetscSleep(0.7*second, ierr))
224  PetscCallA(PetscLogEventEnd(Lessons, ierr))
225
226  PetscCallA(PetscLogEventEnd(Morning, ierr))
227
228  deallocate (message)
229
230  PetscCallA(PetscFinalize(ierr))
231end program SchoolDay
232
233!/*TEST
234!
235! testset:
236!   suffix: no_log
237!   requires: !defined(PETSC_USE_LOG)
238!   test:
239!     suffix: ascii
240!     args: -log_view ascii:filename.txt -log_all
241!   test:
242!     suffix: detail
243!     args: -log_view ascii:filename.txt:ascii_info_detail
244!   test:
245!     suffix: xml
246!     args: -log_view ascii:filename.xml:ascii_xml
247!
248! testset:
249!   args: -log_view ascii:filename.txt
250!   output_file: output/empty.out
251!   requires: defined(PETSC_USE_LOG)
252!   test:
253!     suffix: 1
254!     nsize: 1
255!   test:
256!     suffix: 2
257!     nsize: 2
258!   test:
259!     suffix: 3
260!     nsize: 3
261!
262! testset:
263!   suffix: detail
264!   args: -log_view ascii:filename.txt:ascii_info_detail
265!   output_file: output/empty.out
266!   requires: defined(PETSC_USE_LOG)
267!   test:
268!     suffix: 1
269!     nsize: 1
270!   test:
271!     suffix: 2
272!     nsize: 2
273!   test:
274!     suffix: 3
275!     nsize: 3
276!
277! testset:
278!   suffix: xml
279!   args: -log_view ascii:filename.xml:ascii_xml
280!   output_file: output/empty.out
281!   requires: defined(PETSC_USE_LOG)
282!   test:
283!     suffix: 1
284!     nsize: 1
285!   test:
286!     suffix: 2
287!     nsize: 2
288!   test:
289!     suffix: 3
290!     nsize: 3
291!
292!TEST*/
293