Actual source code: ex1f.F90
petsc-3.15.0 2021-03-30
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*/