Actual source code: ex1f.F90

petsc-master 2018-11-11
Report Typos and Errors
  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:          if (size>1) then
100:          call MPI_Isend( message, msgLen, MPI_DOUBLE_PRECISION,                             &
101:      &                        mod(rank+1,size),                                             &
102:      &                        tagMsg+rank, PETSC_COMM_WORLD, req, ierr)
103:          call  MPI_Recv( message, msgLen, MPI_DOUBLE_PRECISION,                             &
104:      &                       mod(rank-1+size,size),                                         &
105:      &                  tagMsg+mod(rank-1+size,size), PETSC_COMM_WORLD,                     &
106:      &        status, ierr)
107:          call MPI_Wait(req,MPI_STATUS_IGNORE,ierr)
108:          end if
109:          call PetscLogEventEnd(Lessons,ierr)

111:          if (role==TEACHER) then
112:             call PetscLogEventBegin(TidyClass,ierr)
113:             call PetscLogFlops(600000d0,ierr)
114:             call PetscSleep(0.6*second, ierr)
115:                call PetscLogEventBegin(CorrectHomework,ierr)
116:                call PetscLogFlops(234700d0,ierr)
117:                call PetscSleep(0.4*second, ierr)
118:                call PetscLogEventEnd(CorrectHomework,ierr)
119:             call PetscLogEventEnd(TidyClass,ierr)
120:          else if (role==BOY) then
121:             call PetscLogEventBegin(SkipRope,ierr)
122:             call PetscSleep(0.8*second, ierr)
123:             call PetscLogEventEnd(SkipRope,ierr)
124:          else
125:             call PetscLogEventBegin(PlayBall,ierr)
126:             call PetscSleep(0.9*second, ierr)
127:             call PetscLogEventEnd(PlayBall,ierr)
128:          end if

130:          call PetscLogEventBegin(Lessons,ierr)
131:          call PetscLogFlops(120000d0,ierr)
132:          call PetscSleep(0.7*second, ierr)
133:          call PetscLogEventEnd(Lessons,ierr)

135:       call PetscLogEventEnd(Morning,ierr)

137:       call PetscLogEventBegin(Afternoon,ierr)

139:          item = rank*(3-rank)
140:          call MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX,                    &
141:      &                           PETSC_COMM_WORLD, ierr)

143:          item = rank*(10-rank)
144:          call MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX,                    &
145:      &                           PETSC_COMM_WORLD, ierr)

147:          call PetscLogFlops(58988d0,ierr)
148:          call PetscSleep(0.6*second,ierr)

150:          call PetscLogEventBegin(Lessons,ierr)
151:          call PetscLogFlops(123456d0,ierr)
152:          call PetscSleep(1*second, ierr)
153:          call PetscLogEventEnd(Lessons,ierr)

155:          if (role==TEACHER) then
156:             call PetscLogEventBegin(TidyClass,ierr)
157:             call PetscLogFlops(17800d0,ierr)
158:             call PetscSleep(1.1*second, ierr)
159:             call PetscLogEventBegin(Lessons,ierr)
160:             call PetscLogFlops(72344d0,ierr)
161:             call PetscSleep(0.5*second, ierr)
162:             call PetscLogEventEnd(Lessons,ierr)
163:             call PetscLogEventEnd(TidyClass,ierr)
164:          else if (role==GIRL) then
165:             call PetscLogEventBegin(SkipRope,ierr)
166:             call PetscSleep(0.7*second, ierr)
167:             call PetscLogEventEnd(SkipRope,ierr)
168:          else
169:             call PetscLogEventBegin(PlayBall,ierr)
170:             call PetscSleep(0.8*second, ierr)
171:             call PetscLogEventEnd(PlayBall,ierr)
172:          end if

174:          call PetscLogEventBegin(Lessons,ierr)
175:          call PetscLogFlops(72344d0,ierr)
176:          call PetscSleep(0.5*second, ierr)
177:          call PetscLogEventEnd(Lessons,ierr)

179:       call PetscLogEventEnd(Afternoon,ierr)

181:       if (.false.) then
182:          continue
183:       else if (role==TEACHER) then
184:          call PetscLogEventBegin(TidyClass,ierr)
185:          call PetscLogFlops(612300d0,ierr)
186:          call PetscSleep(1.1*second, ierr)
187:          call PetscLogEventEnd(TidyClass,ierr)
188:          call PetscLogEventBegin(CorrectHomework,ierr)
189:          call PetscLogFlops(234700d0,ierr)
190:          call PetscSleep(1.1*second, ierr)
191:          call PetscLogEventEnd(CorrectHomework,ierr)
192:       else
193:          call PetscLogEventBegin(SkipRope,ierr)
194:          call PetscSleep(0.7*second, ierr)
195:          call PetscLogEventEnd(SkipRope,ierr)
196:          call PetscLogEventBegin(PlayBall,ierr)
197:          call PetscSleep(0.8*second, ierr)
198:          call PetscLogEventEnd(PlayBall,ierr)
199:       end if

201:       call PetscLogEventBegin(Lessons,ierr)
202:       call PetscLogFlops(120000d0,ierr)
203:       call PetscSleep(0.7*second, ierr)
204:       call PetscLogEventEnd(Lessons,ierr)

206:       call PetscSleep(0.25*second,ierr)

208:       call PetscLogEventBegin(Morning,ierr)

210:          call PetscLogFlops(190000d0,ierr)
211:          call PetscSleep(0.5*second,ierr)

213:          call PetscLogEventBegin(Lessons,ierr)
214:          call PetscLogFlops(23000d0,ierr)
215:          call PetscSleep(1*second, ierr)
216:          if (size>1) then
217:          call MPI_Isend( message, msgLen, MPI_DOUBLE_PRECISION,                             &
218:      &                        mod(rank+1,size),                                             &
219:      &                   tagMsg+rank, PETSC_COMM_WORLD, req, ierr)
220:          call MPI_Recv( message, msgLen, MPI_DOUBLE_PRECISION,                              &
221:      &                  mod(rank-1+size,size),                                              &
222:      &                  tagMsg+mod(rank-1+size,size), PETSC_COMM_WORLD,                     &
223:      &                   status, ierr)
224:          call MPI_Wait(req,MPI_STATUS_IGNORE,ierr)
225:          end if
226:          call PetscLogEventEnd(Lessons,ierr)

228:          if (role==TEACHER) then
229:             call PetscLogEventBegin(TidyClass,ierr)
230:             call PetscLogFlops(600000d0,ierr)
231:             call PetscSleep(1.2*second, ierr)
232:             call PetscLogEventEnd(TidyClass,ierr)
233:          else if (role==BOY) then
234:             call PetscLogEventBegin(SkipRope,ierr)
235:             call PetscSleep(0.8*second, ierr)
236:             call PetscLogEventEnd(SkipRope,ierr)
237:          else
238:             call PetscLogEventBegin(PlayBall,ierr)
239:             call PetscSleep(0.9*second, ierr)
240:             call PetscLogEventEnd(PlayBall,ierr)
241:          end if

243:          call PetscLogEventBegin(Lessons,ierr)
244:          call PetscLogFlops(120000d0,ierr)
245:          call PetscSleep(0.7*second, ierr)
246:          call PetscLogEventEnd(Lessons,ierr)

248:       call PetscLogEventEnd(Morning,ierr)

250:       deallocate(message)

252:       call PetscFinalize(ierr)

254:       end program SchoolDay

256: !/*TEST
257: !
258: ! testset:
259: !   args: -log_view ascii:filename.txt
260: !   output_file: output/ex1f.out
261: !   test:
262: !     suffix: 1
263: !     nsize: 1
264: !   test:
265: !     suffix: 2
266: !     nsize: 2
267: !   test:
268: !     suffix: 3
269: !     nsize: 3
270: !
271: ! testset:
272: !   suffix: detail
273: !   args: -log_view ascii:filename.txt:ascii_info_detail
274: !   output_file: output/ex1f.out
275: !   test:
276: !     suffix: 1
277: !     nsize: 1
278: !   test:
279: !     suffix: 2
280: !     nsize: 2
281: !   test:
282: !     suffix: 3
283: !     nsize: 3
284: !
285: ! testset:
286: !   suffix: xml
287: !   args: -log_view ascii:filename.xml:ascii_xml
288: !   output_file: output/ex1f.out
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*/