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