Actual source code: ex1f.F90

petsc-master 2020-10-26
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
 36:       PetscClassId classid

 38:       ! Petsc-stuff
 39:       PetscErrorCode            :: ierr

 41:       ! MPI-stuff
 42:       PetscMPIInt              :: rank, size
 43:       PetscReal, allocatable    :: message(:,:)
 44:       integer                   :: item, maxItem
 45:       integer4                  :: status(MPI_STATUS_SIZE)
 46:       PetscMPIInt                  req

 48:       ! Own stuff
 49:       integer4                  :: role                 ! is this process a BOY, a GIRL or a TEACHER?
 50:       integer4                  :: i, j
 51:       integer4,parameter        :: one=1
 52: !====================================================================
 53: !     Initializations
 54:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 55:       if (ierr .ne. 0) then
 56:         print*,'Unable to initialize PETSc'
 57:         stop
 58:       endif
 59:       call MPI_Comm_size(PETSC_COMM_WORLD, size,ierr)
 60:       call MPI_Comm_rank(PETSC_COMM_WORLD, rank,ierr)

 62:       if (rank==0) then
 63:          role = TEACHER
 64:       else if (rank<0.4*size) then
 65:          role = GIRL
 66:       else
 67:          role = BOY
 68:       end if

 70:       allocate(message(msgLen,msglen))
 71:       do i = 1,msgLen
 72:          do j  = 1,msgLen
 73:             message(i,j) = 10.0*j + i*1.0/(rank+one)
 74:          end do
 75:       end do
 76: !
 77: !====================================================================
 78: !     Create new user-defined events
 79:       classid = 0
 80:       call PetscLogEventRegister('Morning',         classid, Morning,   ierr)
 81:       call PetscLogEventRegister('Afternoon',       classid, Afternoon, ierr)
 82:       call PetscLogEventRegister('Play Ball',       classid, PlayBall,  ierr)
 83:       call PetscLogEventRegister('Skip Rope',       classid, SkipRope,  ierr)
 84:       call PetscLogEventRegister('Tidy Classroom',  classid, TidyClass, ierr)
 85:       call PetscLogEventRegister('Lessons',         classid, Lessons,   ierr)
 86:       call PetscLogEventRegister('Correct Homework',classid,CorrectHomework,          &
 87:      &                                                            ierr)
 88:       if (verbose>=1) then
 89:       print '(a,i0,a)','[',rank,'] SchoolDay events have been defined'
 90:       endif

 92: !====================================================================
 93: !     Go through the school day
 94:       call PetscLogEventBegin(Morning,ierr)

 96:          call PetscLogFlops(190000d0,ierr)
 97:          call PetscSleep(0.5*second,ierr)

 99:          call PetscLogEventBegin(Lessons,ierr)
100:          call PetscLogFlops(23000d0,ierr)
101:          call PetscSleep(1*second, ierr)
102:          if (size>1) then
103:          call MPI_Isend( message, msgLen, MPI_DOUBLE_PRECISION,                             &
104:      &                        mod(rank+1,size),                                             &
105:      &                        tagMsg+rank, PETSC_COMM_WORLD, req, ierr)
106:          call  MPI_Recv( message, msgLen, MPI_DOUBLE_PRECISION,                             &
107:      &                       mod(rank-1+size,size),                                         &
108:      &                  tagMsg+mod(rank-1+size,size), PETSC_COMM_WORLD,                     &
109:      &        status, ierr)
110:          call MPI_Wait(req,MPI_STATUS_IGNORE,ierr)
111:          end if
112:          call PetscLogEventEnd(Lessons,ierr)

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

133:          call PetscLogEventBegin(Lessons,ierr)
134:          call PetscLogFlops(120000d0,ierr)
135:          call PetscSleep(0.7*second, ierr)
136:          call PetscLogEventEnd(Lessons,ierr)

138:       call PetscLogEventEnd(Morning,ierr)

140:       call PetscLogEventBegin(Afternoon,ierr)

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

146:          item = rank*(10-rank)
147:          call MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX,                    &
148:      &                           PETSC_COMM_WORLD, ierr)

150:          call PetscLogFlops(58988d0,ierr)
151:          call PetscSleep(0.6*second,ierr)

153:          call PetscLogEventBegin(Lessons,ierr)
154:          call PetscLogFlops(123456d0,ierr)
155:          call PetscSleep(1*second, ierr)
156:          call PetscLogEventEnd(Lessons,ierr)

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

177:          call PetscLogEventBegin(Lessons,ierr)
178:          call PetscLogFlops(72344d0,ierr)
179:          call PetscSleep(0.5*second, ierr)
180:          call PetscLogEventEnd(Lessons,ierr)

182:       call PetscLogEventEnd(Afternoon,ierr)

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

204:       call PetscLogEventBegin(Lessons,ierr)
205:       call PetscLogFlops(120000d0,ierr)
206:       call PetscSleep(0.7*second, ierr)
207:       call PetscLogEventEnd(Lessons,ierr)

209:       call PetscSleep(0.25*second,ierr)

211:       call PetscLogEventBegin(Morning,ierr)

213:          call PetscLogFlops(190000d0,ierr)
214:          call PetscSleep(0.5*second,ierr)

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

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

246:          call PetscLogEventBegin(Lessons,ierr)
247:          call PetscLogFlops(120000d0,ierr)
248:          call PetscSleep(0.7*second, ierr)
249:          call PetscLogEventEnd(Lessons,ierr)

251:       call PetscLogEventEnd(Morning,ierr)

253:       deallocate(message)

255:       call PetscFinalize(ierr)

257:       end program SchoolDay

259: !/*TEST
260: !
261: ! testset:
262: !   args: -log_view ascii:filename.txt
263: !   output_file: output/ex1f.out
264: !   test:
265: !     suffix: 1
266: !     nsize: 1
267: !   test:
268: !     suffix: 2
269: !     nsize: 2
270: !   test:
271: !     suffix: 3
272: !     nsize: 3
273: !
274: ! testset:
275: !   suffix: detail
276: !   args: -log_view ascii:filename.txt:ascii_info_detail
277: !   output_file: output/ex1f.out
278: !   test:
279: !     suffix: 1
280: !     nsize: 1
281: !   test:
282: !     suffix: 2
283: !     nsize: 2
284: !   test:
285: !     suffix: 3
286: !     nsize: 3
287: !
288: ! testset:
289: !   suffix: xml
290: !   args: -log_view ascii:filename.xml:ascii_xml
291: !   output_file: output/ex1f.out
292: !   test:
293: !     suffix: 1
294: !     nsize: 1
295: !   test:
296: !     suffix: 2
297: !     nsize: 2
298: !   test:
299: !     suffix: 3
300: !     nsize: 3
301: !
302: !TEST*/