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