Actual source code: ex1f.F90
petsc-3.8.4 2018-03-24
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
37: ! Petsc-stuff
38: PetscErrorCode :: ierr
40: ! MPI-stuff
41: integer :: rank, size
42: PetscReal, allocatable :: message(:,:)
43: integer :: item, maxItem
44: integer :: status(MPI_STATUS_SIZE)
45: integer :: req
47: ! Own stuff
48: integer :: role ! is this process a BOY, a GIRL or a TEACHER?
49: integer :: i, j
50: !====================================================================
51: ! Initializations
52: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
53: if (ierr .ne. 0) then
54: print*,'Unable to initialize PETSc'
55: stop
56: endif
57: call MPI_Comm_size(PETSC_COMM_WORLD, size,ierr)
58: call MPI_Comm_rank(PETSC_COMM_WORLD, rank,ierr)
60: if (rank==0) then
61: role = TEACHER
62: else if (rank<0.4*size) then
63: role = GIRL
64: else
65: role = BOY
66: end if
68: allocate(message(msgLen,msglen))
69: do i = 1,msgLen
70: do j = 1,msgLen
71: message(i,j) = 10.0*j + i*1.0/(rank+1)
72: end do
73: end do
74: !
75: !====================================================================
76: ! Create new user-defined events
77: call PetscLogEventRegister('Morning', 0, Morning, ierr)
78: call PetscLogEventRegister('Afternoon', 0, Afternoon, ierr)
79: call PetscLogEventRegister('Play Ball', 0, PlayBall, ierr)
80: call PetscLogEventRegister('Skip Rope', 0, SkipRope, ierr)
81: call PetscLogEventRegister('Tidy Classroom', 0, TidyClass, ierr)
82: call PetscLogEventRegister('Lessons', 0, Lessons, ierr)
83: call PetscLogEventRegister('Correct Homework',0,CorrectHomework, &
84: & ierr)
85: if (verbose>=1) then
86: print '(a,i0,a)','[',rank,'] SchoolDay events have been defined'
87: endif
89: !====================================================================
90: ! Go through the school day
91: call PetscLogEventBegin(Morning,ierr)
93: call PetscLogFlops(190000d0,ierr)
94: call PetscSleep(0.5*second,ierr)
96: call PetscLogEventBegin(Lessons,ierr)
97: call PetscLogFlops(23000d0,ierr)
98: call PetscSleep(1*second, ierr)
99: call MPI_iSend( message, msgLen, MPI_DOUBLE_PRECISION, &
100: & mod(rank+1,size), &
101: & tagMsg+rank, PETSC_COMM_WORLD, req, ierr)
102: call MPI_Recv( message, msgLen, MPI_DOUBLE_PRECISION, &
103: & mod(rank-1+size,size), &
104: & tagMsg+mod(rank-1+size,size), PETSC_COMM_WORLD, &
105: & status, ierr)
106: call MPI_Wait(req,MPI_STATUS_IGNORE,ierr)
107: call PetscLogEventEnd(Lessons,ierr)
109: if (role==TEACHER) then
110: call PetscLogEventBegin(TidyClass,ierr)
111: call PetscLogFlops(600000d0,ierr)
112: call PetscSleep(0.6*second, ierr)
113: call PetscLogEventBegin(CorrectHomework,ierr)
114: call PetscLogFlops(234700d0,ierr)
115: call PetscSleep(0.4*second, ierr)
116: call PetscLogEventEnd(CorrectHomework,ierr)
117: call PetscLogEventEnd(TidyClass,ierr)
118: else if (role==BOY) then
119: call PetscLogEventBegin(SkipRope,ierr)
120: call PetscSleep(0.8*second, ierr)
121: call PetscLogEventEnd(SkipRope,ierr)
122: else
123: call PetscLogEventBegin(PlayBall,ierr)
124: call PetscSleep(0.9*second, ierr)
125: call PetscLogEventEnd(PlayBall,ierr)
126: end if
128: call PetscLogEventBegin(Lessons,ierr)
129: call PetscLogFlops(120000d0,ierr)
130: call PetscSleep(0.7*second, ierr)
131: call PetscLogEventEnd(Lessons,ierr)
133: call PetscLogEventEnd(Morning,ierr)
135: call PetscLogEventBegin(Afternoon,ierr)
137: item = rank*(3-rank)
138: call MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX, &
139: & PETSC_COMM_WORLD, ierr)
141: item = rank*(10-rank)
142: call MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX, &
143: & PETSC_COMM_WORLD, ierr)
145: call PetscLogFlops(58988d0,ierr)
146: call PetscSleep(0.6*second,ierr)
148: call PetscLogEventBegin(Lessons,ierr)
149: call PetscLogFlops(123456d0,ierr)
150: call PetscSleep(1*second, ierr)
151: call PetscLogEventEnd(Lessons,ierr)
153: if (role==TEACHER) then
154: call PetscLogEventBegin(TidyClass,ierr)
155: call PetscLogFlops(17800d0,ierr)
156: call PetscSleep(1.1*second, ierr)
157: call PetscLogEventBegin(Lessons,ierr)
158: call PetscLogFlops(72344d0,ierr)
159: call PetscSleep(0.5*second, ierr)
160: call PetscLogEventEnd(Lessons,ierr)
161: call PetscLogEventEnd(TidyClass,ierr)
162: else if (role==GIRL) then
163: call PetscLogEventBegin(SkipRope,ierr)
164: call PetscSleep(0.7*second, ierr)
165: call PetscLogEventEnd(SkipRope,ierr)
166: else
167: call PetscLogEventBegin(PlayBall,ierr)
168: call PetscSleep(0.8*second, ierr)
169: call PetscLogEventEnd(PlayBall,ierr)
170: end if
172: call PetscLogEventBegin(Lessons,ierr)
173: call PetscLogFlops(72344d0,ierr)
174: call PetscSleep(0.5*second, ierr)
175: call PetscLogEventEnd(Lessons,ierr)
177: call PetscLogEventEnd(Afternoon,ierr)
179: if (.false.) then
180: continue
181: else if (role==TEACHER) then
182: call PetscLogEventBegin(TidyClass,ierr)
183: call PetscLogFlops(612300d0,ierr)
184: call PetscSleep(1.1*second, ierr)
185: call PetscLogEventEnd(TidyClass,ierr)
186: call PetscLogEventBegin(CorrectHomework,ierr)
187: call PetscLogFlops(234700d0,ierr)
188: call PetscSleep(1.1*second, ierr)
189: call PetscLogEventEnd(CorrectHomework,ierr)
190: else
191: call PetscLogEventBegin(SkipRope,ierr)
192: call PetscSleep(0.7*second, ierr)
193: call PetscLogEventEnd(SkipRope,ierr)
194: call PetscLogEventBegin(PlayBall,ierr)
195: call PetscSleep(0.8*second, ierr)
196: call PetscLogEventEnd(PlayBall,ierr)
197: end if
199: call PetscLogEventBegin(Lessons,ierr)
200: call PetscLogFlops(120000d0,ierr)
201: call PetscSleep(0.7*second, ierr)
202: call PetscLogEventEnd(Lessons,ierr)
204: call PetscSleep(0.25*second,ierr)
206: call PetscLogEventBegin(Morning,ierr)
208: call PetscLogFlops(190000d0,ierr)
209: call PetscSleep(0.5*second,ierr)
211: call PetscLogEventBegin(Lessons,ierr)
212: call PetscLogFlops(23000d0,ierr)
213: call PetscSleep(1*second, ierr)
214: call MPI_ISend( message, msgLen, MPI_DOUBLE_PRECISION, &
215: & mod(rank+1,size), &
216: & tagMsg+rank, PETSC_COMM_WORLD, req, ierr)
217: call MPI_Recv( message, msgLen, MPI_DOUBLE_PRECISION, &
218: & mod(rank-1+size,size), &
219: & tagMsg+mod(rank-1+size,size), PETSC_COMM_WORLD, &
220: & status, ierr)
221: call MPI_Wait(req,MPI_STATUS_IGNORE,ierr)
222: call PetscLogEventEnd(Lessons,ierr)
224: if (role==TEACHER) then
225: call PetscLogEventBegin(TidyClass,ierr)
226: call PetscLogFlops(600000d0,ierr)
227: call PetscSleep(1.2*second, ierr)
228: call PetscLogEventEnd(TidyClass,ierr)
229: else if (role==BOY) then
230: call PetscLogEventBegin(SkipRope,ierr)
231: call PetscSleep(0.8*second, ierr)
232: call PetscLogEventEnd(SkipRope,ierr)
233: else
234: call PetscLogEventBegin(PlayBall,ierr)
235: call PetscSleep(0.9*second, ierr)
236: call PetscLogEventEnd(PlayBall,ierr)
237: end if
239: call PetscLogEventBegin(Lessons,ierr)
240: call PetscLogFlops(120000d0,ierr)
241: call PetscSleep(0.7*second, ierr)
242: call PetscLogEventEnd(Lessons,ierr)
244: call PetscLogEventEnd(Morning,ierr)
246: deallocate(message)
248: call PetscFinalize(ierr)
250: end program SchoolDay