Actual source code: ex3f90.F90
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>
8: program SchoolDay
9: use petscmpi ! or mpi or mpi_f08
10: use petscsys
11: implicit none
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
18: ! Codes
19: integer, parameter :: BOY = 1, GIRL = 2, TEACHER = 0
20: PetscMPIInt, parameter :: tagMsg = 1200
22: ! Timers
23: PetscLogEvent :: Morning, Afternoon
24: PetscLogEvent :: PlayBall, SkipRope
25: PetscLogEvent :: TidyClass
26: PetscLogEvent :: Lessons, CorrectHomework
27: PetscClassId classid
29: ! Petsc-stuff
30: PetscErrorCode :: ierr
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
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
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))
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
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
78: ! Go through the school day
79: PetscCallA(PetscLogEventBegin(Morning, ierr))
81: PetscCallA(PetscLogFlops(190000d0, ierr))
82: PetscCallA(PetscSleep(0.5*second, ierr))
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))
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
116: PetscCallA(PetscLogEventBegin(Lessons, ierr))
117: PetscCallA(PetscLogFlops(120000d0, ierr))
118: PetscCallA(PetscSleep(0.7*second, ierr))
119: PetscCallA(PetscLogEventEnd(Lessons, ierr))
121: PetscCallA(PetscLogEventEnd(Morning, ierr))
123: PetscCallA(PetscLogEventBegin(Afternoon, ierr))
125: item = rank*(3 - rank)
126: PetscCallMPIA(MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX, PETSC_COMM_WORLD, ierr))
127: ierr = PetscAReduce()
129: item = rank*(10 - rank)
130: PetscCallMPIA(MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX, PETSC_COMM_WORLD, ierr))
131: ierr = PetscAReduce()
133: PetscCallA(PetscLogFlops(58988d0, ierr))
134: PetscCallA(PetscSleep(0.6*second, ierr))
136: PetscCallA(PetscLogEventBegin(Lessons, ierr))
137: PetscCallA(PetscLogFlops(123456d0, ierr))
138: PetscCallA(PetscSleep(1*second, ierr))
139: PetscCallA(PetscLogEventEnd(Lessons, ierr))
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
160: PetscCallA(PetscLogEventBegin(Lessons, ierr))
161: PetscCallA(PetscLogFlops(72344d0, ierr))
162: PetscCallA(PetscSleep(0.5*second, ierr))
163: PetscCallA(PetscLogEventEnd(Lessons, ierr))
165: PetscCallA(PetscLogEventEnd(Afternoon, ierr))
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
187: PetscCallA(PetscLogEventBegin(Lessons, ierr))
188: PetscCallA(PetscLogFlops(120000d0, ierr))
189: PetscCallA(PetscSleep(0.7*second, ierr))
190: PetscCallA(PetscLogEventEnd(Lessons, ierr))
192: PetscCallA(PetscSleep(0.25*second, ierr))
194: PetscCallA(PetscLogEventBegin(Morning, ierr))
196: PetscCallA(PetscLogFlops(190000d0, ierr))
197: PetscCallA(PetscSleep(0.5*second, ierr))
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))
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
227: PetscCallA(PetscLogEventBegin(Lessons, ierr))
228: PetscCallA(PetscLogFlops(120000d0, ierr))
229: PetscCallA(PetscSleep(0.7*second, ierr))
230: PetscCallA(PetscLogEventEnd(Lessons, ierr))
232: PetscCallA(PetscLogEventEnd(Morning, ierr))
234: deallocate (message)
236: PetscCallA(PetscFinalize(ierr))
237: end program SchoolDay
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*/