Actual source code: ex1f.F90

petsc-3.15.0 2021-04-05
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 petscmpi  ! or mpi or mpi_f08
 17:       use petscsys
 18:       implicit none

 20: !====================================================================
 21: !     Local Variables

 23:       ! Settings:
 24:       integer, parameter        :: verbose=0               ! 0: silent, >=1 : increasing amount of debugging output
 25:       integer, parameter        :: msgLen = 30             ! number of reals which is sent with MPI_Isend
 26:       PetscReal, parameter      :: second=0.1;             ! time is sped up by a factor 10

 28:       ! Codes
 29:       integer, parameter        :: BOY=1, GIRL=2, TEACHER=0
 30:       PetscMPIInt, parameter    :: tagMsg   = 1200;

 32:       ! Timers
 33:       PetscLogEvent :: Morning,  Afternoon
 34:       PetscLogEvent :: PlayBall, SkipRope
 35:       PetscLogEvent :: TidyClass
 36:       PetscLogEvent :: Lessons,  CorrectHomework
 37:       PetscClassId classid

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

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

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

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

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

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

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

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

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

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

139:       call PetscLogEventEnd(Morning,ierr)

141:       call PetscLogEventBegin(Afternoon,ierr)

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

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

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

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

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

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

183:       call PetscLogEventEnd(Afternoon,ierr)

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

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

210:       call PetscSleep(0.25*second,ierr)

212:       call PetscLogEventBegin(Morning,ierr)

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

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

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

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

252:       call PetscLogEventEnd(Morning,ierr)

254:       deallocate(message)

256:       call PetscFinalize(ierr)

258:       end program SchoolDay

260: !/*TEST
261: !
262: ! testset:
263: !   args: -log_view ascii:filename.txt
264: !   output_file: output/ex1f.out
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: detail
277: !   args: -log_view ascii:filename.txt:ascii_info_detail
278: !   output_file: output/ex1f.out
279: !   test:
280: !     suffix: 1
281: !     nsize: 1
282: !   test:
283: !     suffix: 2
284: !     nsize: 2
285: !   test:
286: !     suffix: 3
287: !     nsize: 3
288: !
289: ! testset:
290: !   suffix: xml
291: !   args: -log_view ascii:filename.xml:ascii_xml
292: !   output_file: output/ex1f.out
293: !   test:
294: !     suffix: 1
295: !     nsize: 1
296: !   test:
297: !     suffix: 2
298: !     nsize: 2
299: !   test:
300: !     suffix: 3
301: !     nsize: 3
302: !
303: !TEST*/