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

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