xref: /petsc/src/sys/tutorials/ex3f90.F90 (revision f84028053d197aff3fdf060e86d88b3f1b0f0110)
1!
2!
3!   Description: Demonstrates how users can augment the PETSc profiling by
4!                inserting their own event logging.
5!
6
7      program SchoolDay
8#include <petsc/finclude/petscsys.h>
9#include <petsc/finclude/petsclog.h>
10      use petscmpi  ! or mpi or mpi_f08
11      use petscsys
12      implicit none
13
14      ! Settings:
15      integer, parameter        :: verbose=0               ! 0: silent, >=1 : increasing amount of debugging output
16      integer, parameter        :: msgLen = 30             ! number of reals which is sent with MPI_Isend
17      PetscReal, parameter      :: second=0.1;             ! time is sped up by a factor 10
18
19      ! Codes
20      integer, parameter        :: BOY=1, GIRL=2, TEACHER=0
21      PetscMPIInt, parameter    :: tagMsg   = 1200;
22
23      ! Timers
24      PetscLogEvent :: Morning,  Afternoon
25      PetscLogEvent :: PlayBall, SkipRope
26      PetscLogEvent :: TidyClass
27      PetscLogEvent :: Lessons,  CorrectHomework
28      PetscClassId classid
29
30      ! Petsc-stuff
31      PetscErrorCode            :: ierr
32
33      ! MPI-stuff
34      PetscMPIInt              :: rank, size
35      PetscReal, allocatable    :: message(:,:)
36      integer                   :: item, maxItem
37      integer4                  :: status(MPI_STATUS_SIZE)
38      PetscMPIInt                  req
39
40      ! Own stuff
41      integer4                  :: role                 ! is this process a BOY, a GIRL or a TEACHER?
42      integer4                  :: i, j
43      integer4,parameter        :: one=1
44
45!     Initializations
46      PetscCallA( PetscInitialize(PETSC_NULL_CHARACTER,ierr))
47      PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD, size,ierr))
48      PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank,ierr))
49
50      if (rank==0) then
51         role = TEACHER
52      else if (rank<0.4*size) then
53         role = GIRL
54      else
55         role = BOY
56      end if
57
58      allocate(message(msgLen,msglen))
59      do i = 1,msgLen
60         do j  = 1,msgLen
61            message(i,j) = 10.0*j + i*1.0/(rank+one)
62         end do
63      end do
64!
65!     Create new user-defined events
66      classid = 0
67      PetscCallA(PetscLogEventRegister('Morning',         classid, Morning,   ierr))
68      PetscCallA(PetscLogEventRegister('Afternoon',       classid, Afternoon, ierr))
69      PetscCallA(PetscLogEventRegister('Play Ball',       classid, PlayBall,  ierr))
70      PetscCallA(PetscLogEventRegister('Skip Rope',       classid, SkipRope,  ierr))
71      PetscCallA(PetscLogEventRegister('Tidy Classroom',  classid, TidyClass, ierr))
72      PetscCallA(PetscLogEventRegister('Lessons',         classid, Lessons,   ierr))
73      PetscCallA(PetscLogEventRegister('Correct Homework',classid,CorrectHomework,ierr))
74      if (verbose>=1) then
75        print '(a,i0,a)','[',rank,'] SchoolDay events have been defined'
76      endif
77
78!     Go through the school day
79      PetscCallA(PetscLogEventBegin(Morning,ierr))
80
81         PetscCallA(PetscLogFlops(190000d0,ierr))
82         PetscCallA(PetscSleep(0.5*second,ierr))
83
84         PetscCallA(PetscLogEventBegin(Lessons,ierr))
85         PetscCallA(PetscLogFlops(23000d0,ierr))
86         PetscCallA(PetscSleep(1*second, ierr))
87         if (size>1) then
88         call MPI_Isend( message, msgLen, MPI_DOUBLE_PRECISION,                             &
89     &                        mod(rank+1,size),                                             &
90     &                        tagMsg+rank, PETSC_COMM_WORLD, req, ierr)
91         call  MPI_Recv( message, msgLen, MPI_DOUBLE_PRECISION,                             &
92     &                       mod(rank-1+size,size),                                         &
93     &                  tagMsg+mod(rank-1+size,size), PETSC_COMM_WORLD,                     &
94     &        status, ierr)
95         PetscCallMPIA(MPI_Wait(req,MPI_STATUS_IGNORE,ierr))
96         end if
97         PetscCallA(PetscLogEventEnd(Lessons,ierr))
98
99         if (role==TEACHER) then
100            PetscCallA(PetscLogEventBegin(TidyClass,ierr))
101            PetscCallA(PetscLogFlops(600000d0,ierr))
102            PetscCallA(PetscSleep(0.6*second, ierr))
103               PetscCallA(PetscLogEventBegin(CorrectHomework,ierr))
104               PetscCallA(PetscLogFlops(234700d0,ierr))
105               PetscCallA(PetscSleep(0.4*second, ierr))
106               PetscCallA(PetscLogEventEnd(CorrectHomework,ierr))
107            PetscCallA(PetscLogEventEnd(TidyClass,ierr))
108         else if (role==BOY) then
109            PetscCallA(PetscLogEventBegin(SkipRope,ierr))
110            PetscCallA(PetscSleep(0.8*second, ierr))
111            PetscCallA(PetscLogEventEnd(SkipRope,ierr))
112         else
113            PetscCallA(PetscLogEventBegin(PlayBall,ierr))
114            PetscCallA(PetscSleep(0.9*second, ierr))
115            PetscCallA(PetscLogEventEnd(PlayBall,ierr))
116         end if
117
118         PetscCallA(PetscLogEventBegin(Lessons,ierr))
119         PetscCallA(PetscLogFlops(120000d0,ierr))
120         PetscCallA(PetscSleep(0.7*second, ierr))
121         PetscCallA(PetscLogEventEnd(Lessons,ierr))
122
123      PetscCallA(PetscLogEventEnd(Morning,ierr))
124
125      PetscCallA(PetscLogEventBegin(Afternoon,ierr))
126
127         item = rank*(3-rank)
128         PetscCallMPIA(MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX,PETSC_COMM_WORLD, ierr))
129
130         item = rank*(10-rank)
131         PetscCallMPIA(MPI_Allreduce(item, maxItem, 1, MPI_INTEGER, MPI_MAX,PETSC_COMM_WORLD, ierr))
132
133         PetscCallA(PetscLogFlops(58988d0,ierr))
134         PetscCallA(PetscSleep(0.6*second,ierr))
135
136         PetscCallA(PetscLogEventBegin(Lessons,ierr))
137         PetscCallA(PetscLogFlops(123456d0,ierr))
138         PetscCallA(PetscSleep(1*second, ierr))
139         PetscCallA(PetscLogEventEnd(Lessons,ierr))
140
141         if (role==TEACHER) then
142            PetscCallA(PetscLogEventBegin(TidyClass,ierr))
143            PetscCallA(PetscLogFlops(17800d0,ierr))
144            PetscCallA(PetscSleep(1.1*second, ierr))
145            PetscCallA(PetscLogEventBegin(Lessons,ierr))
146            PetscCallA(PetscLogFlops(72344d0,ierr))
147            PetscCallA(PetscSleep(0.5*second, ierr))
148            PetscCallA(PetscLogEventEnd(Lessons,ierr))
149            PetscCallA(PetscLogEventEnd(TidyClass,ierr))
150         else if (role==GIRL) then
151            PetscCallA(PetscLogEventBegin(SkipRope,ierr))
152            PetscCallA(PetscSleep(0.7*second, ierr))
153            PetscCallA(PetscLogEventEnd(SkipRope,ierr))
154         else
155            PetscCallA(PetscLogEventBegin(PlayBall,ierr))
156            PetscCallA(PetscSleep(0.8*second, ierr))
157            PetscCallA(PetscLogEventEnd(PlayBall,ierr))
158         end if
159
160         PetscCallA(PetscLogEventBegin(Lessons,ierr))
161         PetscCallA(PetscLogFlops(72344d0,ierr))
162         PetscCallA(PetscSleep(0.5*second, ierr))
163         PetscCallA(PetscLogEventEnd(Lessons,ierr))
164
165      PetscCallA(PetscLogEventEnd(Afternoon,ierr))
166
167      if (.false.) then
168         continue
169      else if (role==TEACHER) then
170         PetscCallA(PetscLogEventBegin(TidyClass,ierr))
171         PetscCallA(PetscLogFlops(612300d0,ierr))
172         PetscCallA(PetscSleep(1.1*second, ierr))
173         PetscCallA(PetscLogEventEnd(TidyClass,ierr))
174         PetscCallA(PetscLogEventBegin(CorrectHomework,ierr))
175         PetscCallA(PetscLogFlops(234700d0,ierr))
176         PetscCallA(PetscSleep(1.1*second, ierr))
177         PetscCallA(PetscLogEventEnd(CorrectHomework,ierr))
178      else
179         PetscCallA(PetscLogEventBegin(SkipRope,ierr))
180         PetscCallA(PetscSleep(0.7*second, ierr))
181         PetscCallA(PetscLogEventEnd(SkipRope,ierr))
182         PetscCallA(PetscLogEventBegin(PlayBall,ierr))
183         PetscCallA(PetscSleep(0.8*second, ierr))
184         PetscCallA(PetscLogEventEnd(PlayBall,ierr))
185      end if
186
187      PetscCallA(PetscLogEventBegin(Lessons,ierr))
188      PetscCallA(PetscLogFlops(120000d0,ierr))
189      PetscCallA(PetscSleep(0.7*second, ierr))
190      PetscCallA(PetscLogEventEnd(Lessons,ierr))
191
192      PetscCallA(PetscSleep(0.25*second,ierr))
193
194      PetscCallA(PetscLogEventBegin(Morning,ierr))
195
196         PetscCallA(PetscLogFlops(190000d0,ierr))
197         PetscCallA(PetscSleep(0.5*second,ierr))
198
199         PetscCallA(PetscLogEventBegin(Lessons,ierr))
200         PetscCallA(PetscLogFlops(23000d0,ierr))
201         PetscCallA(PetscSleep(1*second, ierr))
202         if (size>1) then
203         call MPI_Isend( message, msgLen, MPI_DOUBLE_PRECISION,                             &
204     &                   mod(rank+1,size),                                                  &
205     &                   tagMsg+rank, PETSC_COMM_WORLD, req, ierr)
206         call MPI_Recv( message, msgLen, MPI_DOUBLE_PRECISION,                              &
207     &                  mod(rank-1+size,size),                                              &
208     &                  tagMsg+mod(rank-1+size,size), PETSC_COMM_WORLD,                     &
209     &                  status, ierr)
210         PetscCallMPIA(MPI_Wait(req,MPI_STATUS_IGNORE,ierr))
211         end if
212         PetscCallA(PetscLogEventEnd(Lessons,ierr))
213
214         if (role==TEACHER) then
215            PetscCallA(PetscLogEventBegin(TidyClass,ierr))
216            PetscCallA(PetscLogFlops(600000d0,ierr))
217            PetscCallA(PetscSleep(1.2*second, ierr))
218            PetscCallA(PetscLogEventEnd(TidyClass,ierr))
219         else if (role==BOY) then
220            PetscCallA(PetscLogEventBegin(SkipRope,ierr))
221            PetscCallA(PetscSleep(0.8*second, ierr))
222            PetscCallA(PetscLogEventEnd(SkipRope,ierr))
223         else
224            PetscCallA(PetscLogEventBegin(PlayBall,ierr))
225            PetscCallA(PetscSleep(0.9*second, ierr))
226            PetscCallA(PetscLogEventEnd(PlayBall,ierr))
227         end if
228
229         PetscCallA(PetscLogEventBegin(Lessons,ierr))
230         PetscCallA(PetscLogFlops(120000d0,ierr))
231         PetscCallA(PetscSleep(0.7*second, ierr))
232         PetscCallA(PetscLogEventEnd(Lessons,ierr))
233
234      PetscCallA(PetscLogEventEnd(Morning,ierr))
235
236      deallocate(message)
237
238      PetscCallA(PetscFinalize(ierr))
239      end program SchoolDay
240
241!/*TEST
242!
243! testset:
244!   suffix: no_log
245!   requires: !defined(PETSC_USE_LOG)
246!   test:
247!     suffix: ascii
248!     args: -log_view ascii:filename.txt
249!   test:
250!     suffix: detail
251!     args: -log_view ascii:filename.txt:ascii_info_detail
252!   test:
253!     suffix: xml
254!     args: -log_view ascii:filename.xml:ascii_xml
255!
256! testset:
257!   args: -log_view ascii:filename.txt
258!   output_file: output/ex3f90.out
259!   requires: defined(PETSC_USE_LOG)
260!   test:
261!     suffix: 1
262!     nsize: 1
263!   test:
264!     suffix: 2
265!     nsize: 2
266!   test:
267!     suffix: 3
268!     nsize: 3
269!
270! testset:
271!   suffix: detail
272!   args: -log_view ascii:filename.txt:ascii_info_detail
273!   output_file: output/ex3f90.out
274!   requires: defined(PETSC_USE_LOG)
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/ex3f90.out
289!   requires: defined(PETSC_USE_LOG)
290!   test:
291!     suffix: 1
292!     nsize: 1
293!   test:
294!     suffix: 2
295!     nsize: 2
296!   test:
297!     suffix: 3
298!     nsize: 3
299!
300!TEST*/
301