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