Actual source code: ex1f.F90
petsc-3.13.6 2020-09-29
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*/