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

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

 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:          end if
 92:          PetscCallA(PetscLogEventEnd(Lessons,ierr))

 94:          if (role==TEACHER) then
 95:             PetscCallA(PetscLogEventBegin(TidyClass,ierr))
 96:             PetscCallA(PetscLogFlops(600000d0,ierr))
 97:             PetscCallA(PetscSleep(0.6*second, ierr))
 98:                PetscCallA(PetscLogEventBegin(CorrectHomework,ierr))
 99:                PetscCallA(PetscLogFlops(234700d0,ierr))
100:                PetscCallA(PetscSleep(0.4*second, ierr))
101:                PetscCallA(PetscLogEventEnd(CorrectHomework,ierr))
102:             PetscCallA(PetscLogEventEnd(TidyClass,ierr))
103:          else if (role==BOY) then
104:             PetscCallA(PetscLogEventBegin(SkipRope,ierr))
105:             PetscCallA(PetscSleep(0.8*second, ierr))
106:             PetscCallA(PetscLogEventEnd(SkipRope,ierr))
107:          else
108:             PetscCallA(PetscLogEventBegin(PlayBall,ierr))
109:             PetscCallA(PetscSleep(0.9*second, ierr))
110:             PetscCallA(PetscLogEventEnd(PlayBall,ierr))
111:          end if

113:          PetscCallA(PetscLogEventBegin(Lessons,ierr))
114:          PetscCallA(PetscLogFlops(120000d0,ierr))
115:          PetscCallA(PetscSleep(0.7*second, ierr))
116:          PetscCallA(PetscLogEventEnd(Lessons,ierr))

118:       PetscCallA(PetscLogEventEnd(Morning,ierr))

120:       PetscCallA(PetscLogEventBegin(Afternoon,ierr))

122:          item = rank*(3-rank)
123:          PetscCallMPIA(MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX,PETSC_COMM_WORLD, ierr))

125:          item = rank*(10-rank)
126:          PetscCallMPIA(MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX,PETSC_COMM_WORLD, ierr))

128:          PetscCallA(PetscLogFlops(58988d0,ierr))
129:          PetscCallA(PetscSleep(0.6*second,ierr))

131:          PetscCallA(PetscLogEventBegin(Lessons,ierr))
132:          PetscCallA(PetscLogFlops(123456d0,ierr))
133:          PetscCallA(PetscSleep(1*second, ierr))
134:          PetscCallA(PetscLogEventEnd(Lessons,ierr))

136:          if (role==TEACHER) then
137:             PetscCallA(PetscLogEventBegin(TidyClass,ierr))
138:             PetscCallA(PetscLogFlops(17800d0,ierr))
139:             PetscCallA(PetscSleep(1.1*second, ierr))
140:             PetscCallA(PetscLogEventBegin(Lessons,ierr))
141:             PetscCallA(PetscLogFlops(72344d0,ierr))
142:             PetscCallA(PetscSleep(0.5*second, ierr))
143:             PetscCallA(PetscLogEventEnd(Lessons,ierr))
144:             PetscCallA(PetscLogEventEnd(TidyClass,ierr))
145:          else if (role==GIRL) then
146:             PetscCallA(PetscLogEventBegin(SkipRope,ierr))
147:             PetscCallA(PetscSleep(0.7*second, ierr))
148:             PetscCallA(PetscLogEventEnd(SkipRope,ierr))
149:          else
150:             PetscCallA(PetscLogEventBegin(PlayBall,ierr))
151:             PetscCallA(PetscSleep(0.8*second, ierr))
152:             PetscCallA(PetscLogEventEnd(PlayBall,ierr))
153:          end if

155:          PetscCallA(PetscLogEventBegin(Lessons,ierr))
156:          PetscCallA(PetscLogFlops(72344d0,ierr))
157:          PetscCallA(PetscSleep(0.5*second, ierr))
158:          PetscCallA(PetscLogEventEnd(Lessons,ierr))

160:       PetscCallA(PetscLogEventEnd(Afternoon,ierr))

162:       if (.false.) then
163:          continue
164:       else if (role==TEACHER) then
165:          PetscCallA(PetscLogEventBegin(TidyClass,ierr))
166:          PetscCallA(PetscLogFlops(612300d0,ierr))
167:          PetscCallA(PetscSleep(1.1*second, ierr))
168:          PetscCallA(PetscLogEventEnd(TidyClass,ierr))
169:          PetscCallA(PetscLogEventBegin(CorrectHomework,ierr))
170:          PetscCallA(PetscLogFlops(234700d0,ierr))
171:          PetscCallA(PetscSleep(1.1*second, ierr))
172:          PetscCallA(PetscLogEventEnd(CorrectHomework,ierr))
173:       else
174:          PetscCallA(PetscLogEventBegin(SkipRope,ierr))
175:          PetscCallA(PetscSleep(0.7*second, ierr))
176:          PetscCallA(PetscLogEventEnd(SkipRope,ierr))
177:          PetscCallA(PetscLogEventBegin(PlayBall,ierr))
178:          PetscCallA(PetscSleep(0.8*second, ierr))
179:          PetscCallA(PetscLogEventEnd(PlayBall,ierr))
180:       end if

182:       PetscCallA(PetscLogEventBegin(Lessons,ierr))
183:       PetscCallA(PetscLogFlops(120000d0,ierr))
184:       PetscCallA(PetscSleep(0.7*second, ierr))
185:       PetscCallA(PetscLogEventEnd(Lessons,ierr))

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

189:       PetscCallA(PetscLogEventBegin(Morning,ierr))

191:          PetscCallA(PetscLogFlops(190000d0,ierr))
192:          PetscCallA(PetscSleep(0.5*second,ierr))

194:          PetscCallA(PetscLogEventBegin(Lessons,ierr))
195:          PetscCallA(PetscLogFlops(23000d0,ierr))
196:          PetscCallA(PetscSleep(1*second, ierr))
197:          if (size>1) then
198:            PetscCallMPIA(MPI_Isend( message, msgLen, MPI_DOUBLE_PRECISION,mod(rank+1,size),tagMsg+rank, PETSC_COMM_WORLD, req, ierr))
199:            PetscCallMPIA(MPI_Recv( message, msgLen, MPI_DOUBLE_PRECISION,mod(rank-1+size,size),tagMsg+mod(rank-1+size,size), PETSC_COMM_WORLD,status, ierr))
200:            PetscCallMPIA(MPI_Wait(req,MPI_STATUS_IGNORE,ierr))
201:          end if
202:          PetscCallA(PetscLogEventEnd(Lessons,ierr))

204:          if (role==TEACHER) then
205:             PetscCallA(PetscLogEventBegin(TidyClass,ierr))
206:             PetscCallA(PetscLogFlops(600000d0,ierr))
207:             PetscCallA(PetscSleep(1.2*second, ierr))
208:             PetscCallA(PetscLogEventEnd(TidyClass,ierr))
209:          else if (role==BOY) then
210:             PetscCallA(PetscLogEventBegin(SkipRope,ierr))
211:             PetscCallA(PetscSleep(0.8*second, ierr))
212:             PetscCallA(PetscLogEventEnd(SkipRope,ierr))
213:          else
214:             PetscCallA(PetscLogEventBegin(PlayBall,ierr))
215:             PetscCallA(PetscSleep(0.9*second, ierr))
216:             PetscCallA(PetscLogEventEnd(PlayBall,ierr))
217:          end if

219:          PetscCallA(PetscLogEventBegin(Lessons,ierr))
220:          PetscCallA(PetscLogFlops(120000d0,ierr))
221:          PetscCallA(PetscSleep(0.7*second, ierr))
222:          PetscCallA(PetscLogEventEnd(Lessons,ierr))

224:       PetscCallA(PetscLogEventEnd(Morning,ierr))

226:       deallocate(message)

228:       PetscCallA(PetscFinalize(ierr))
229:       end program SchoolDay

231: !/*TEST
232: !
233: ! testset:
234: !   suffix: no_log
235: !   requires: !defined(PETSC_USE_LOG)
236: !   test:
237: !     suffix: ascii
238: !     args: -log_view ascii:filename.txt
239: !   test:
240: !     suffix: detail
241: !     args: -log_view ascii:filename.txt:ascii_info_detail
242: !   test:
243: !     suffix: xml
244: !     args: -log_view ascii:filename.xml:ascii_xml
245: !
246: ! testset:
247: !   args: -log_view ascii:filename.txt
248: !   output_file: output/ex3f90.out
249: !   requires: defined(PETSC_USE_LOG)
250: !   test:
251: !     suffix: 1
252: !     nsize: 1
253: !   test:
254: !     suffix: 2
255: !     nsize: 2
256: !   test:
257: !     suffix: 3
258: !     nsize: 3
259: !
260: ! testset:
261: !   suffix: detail
262: !   args: -log_view ascii:filename.txt:ascii_info_detail
263: !   output_file: output/ex3f90.out
264: !   requires: defined(PETSC_USE_LOG)
265: !   test:
266: !     suffix: 1
267: !     nsize: 1
268: !   test:
269: !     suffix: 2
270: !     nsize: 2
271: !   test:
272: !     suffix: 3
273: !     nsize: 3
274: !
275: ! testset:
276: !   suffix: xml
277: !   args: -log_view ascii:filename.xml:ascii_xml
278: !   output_file: output/ex3f90.out
279: !   requires: defined(PETSC_USE_LOG)
280: !   test:
281: !     suffix: 1
282: !     nsize: 1
283: !   test:
284: !     suffix: 2
285: !     nsize: 2
286: !   test:
287: !     suffix: 3
288: !     nsize: 3
289: !
290: !TEST*/