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: !

  7: program 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

 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

 19:   ! Codes
 20:   integer, parameter        :: BOY = 1, GIRL = 2, TEACHER = 0
 21:   PetscMPIInt, parameter    :: tagMsg = 1200

 23:   ! Timers
 24:   PetscLogEvent :: Morning, Afternoon
 25:   PetscLogEvent :: PlayBall, SkipRope
 26:   PetscLogEvent :: TidyClass
 27:   PetscLogEvent :: Lessons, CorrectHomework
 28:   PetscClassId classid

 30:   ! Petsc-stuff
 31:   PetscErrorCode            :: ierr

 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

 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

 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))

 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

 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

 79: !     Go through the school day
 80:   PetscCallA(PetscLogEventBegin(Morning, ierr))

 82:   PetscCallA(PetscLogFlops(190000d0, ierr))
 83:   PetscCallA(PetscSleep(0.5*second, ierr))

 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))

 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

117:   PetscCallA(PetscLogEventBegin(Lessons, ierr))
118:   PetscCallA(PetscLogFlops(120000d0, ierr))
119:   PetscCallA(PetscSleep(0.7*second, ierr))
120:   PetscCallA(PetscLogEventEnd(Lessons, ierr))

122:   PetscCallA(PetscLogEventEnd(Morning, ierr))

124:   PetscCallA(PetscLogEventBegin(Afternoon, ierr))

126:   item = rank*(3 - rank)
127:   PetscCallMPIA(MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX, PETSC_COMM_WORLD, ierr))
128:   ierr = PetscAReduce()

130:   item = rank*(10 - rank)
131:   PetscCallMPIA(MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX, PETSC_COMM_WORLD, ierr))
132:   ierr = PetscAReduce()

134:   PetscCallA(PetscLogFlops(58988d0, ierr))
135:   PetscCallA(PetscSleep(0.6*second, ierr))

137:   PetscCallA(PetscLogEventBegin(Lessons, ierr))
138:   PetscCallA(PetscLogFlops(123456d0, ierr))
139:   PetscCallA(PetscSleep(1*second, ierr))
140:   PetscCallA(PetscLogEventEnd(Lessons, ierr))

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

161:   PetscCallA(PetscLogEventBegin(Lessons, ierr))
162:   PetscCallA(PetscLogFlops(72344d0, ierr))
163:   PetscCallA(PetscSleep(0.5*second, ierr))
164:   PetscCallA(PetscLogEventEnd(Lessons, ierr))

166:   PetscCallA(PetscLogEventEnd(Afternoon, ierr))

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

188:   PetscCallA(PetscLogEventBegin(Lessons, ierr))
189:   PetscCallA(PetscLogFlops(120000d0, ierr))
190:   PetscCallA(PetscSleep(0.7*second, ierr))
191:   PetscCallA(PetscLogEventEnd(Lessons, ierr))

193:   PetscCallA(PetscSleep(0.25*second, ierr))

195:   PetscCallA(PetscLogEventBegin(Morning, ierr))

197:   PetscCallA(PetscLogFlops(190000d0, ierr))
198:   PetscCallA(PetscSleep(0.5*second, ierr))

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))

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

228:   PetscCallA(PetscLogEventBegin(Lessons, ierr))
229:   PetscCallA(PetscLogFlops(120000d0, ierr))
230:   PetscCallA(PetscSleep(0.7*second, ierr))
231:   PetscCallA(PetscLogEventEnd(Lessons, ierr))

233:   PetscCallA(PetscLogEventEnd(Morning, ierr))

235:   deallocate (message)

237:   PetscCallA(PetscFinalize(ierr))
238: end program SchoolDay

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*/