source: palm/trunk/SOURCE/cpulog.f90 @ 1401

Last change on this file since 1401 was 1370, checked in by raasch, 10 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 21.3 KB
Line 
1 MODULE cpulog
2
3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2014 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: cpulog.f90 1370 2014-04-24 06:06:17Z knoop $
27!
28! 1369 2014-04-24 05:57:38Z raasch
29! routine description added
30!
31! 1353 2014-04-08 15:21:23Z heinze
32! REAL constants provided with KIND-attribute
33!
34! 1322 2014-03-20 16:38:49Z raasch
35! REAL functions provided with KIND-attribute
36!
37! 1320 2014-03-20 08:40:49Z raasch
38! ONLY-attribute added to USE-statements,
39! kind-parameters added to all INTEGER and REAL declaration statements,
40! kinds are defined in new module kinds,
41! revision history before 2012 removed,
42! comment fields (!:) to be used for variable explanations added to
43! all variable declaration statements
44!
45! 1318 2014-03-17 13:35:16Z raasch
46! former files/routines cpu_log and cpu_statistics combined to one module,
47! which also includes the former data module cpulog from the modules-file
48!
49! 1036 2012-10-22 13:43:42Z raasch
50! code put under GPL (PALM 3.9)
51!
52! Revision 1.1  1997/07/24 11:12:29  raasch
53! Initial revision
54!
55!
56! Description:
57! ------------
58! CPU-time measurements for any program part whatever. Results of the
59! measurements are output at the end of the run in local file CPU_MEASURES.
60!
61! To measure the CPU-time (better to say the wallclock time) of a specific code
62! segment, two calls of cpu_log have to be used as brackets in front and at the
63! end of the segment:
64!
65!     CALL cpu_log( log_point(n), 'any identifier', 'start' )
66!       ... code segment ...
67!     CALL cpu_log( log_point(n), 'any identifier', 'stop' )
68!
69! Parts of the code segment can be excluded from the measurement by additional
70! call of cpu_log:
71!
72!       ... first segment to be measured
73!     CALL cpu_log( log_point(n), 'any identifier', 'pause' )
74!       ... oart of segment to be excluded from measurement
75!     CALL cpu_log( log_point(n), 'any identifier', 'continue' )
76!       ... second segment to be mesasured
77!
78! n is an INTEGER within the interval [1,100] defining the id of the specific
79! code segment, 'any identifier' is a string describing the code segment to be
80! measured. It can be freely chosen and results will appear under this name in
81! file CPU_MEASURES. ids can only be used once. If you like to do a
82! measurement of a new part of the code, please look for an id which is unused
83! ao far.
84!
85! d3par-parameter cpu_log_barrierwait can be used to set an MPI barrier at the
86! beginning of the measurement (modus 'start' or 'continue'), to avoid that
87! idle times (due to MPI calls in the code segment, which are
88! waiting for other processes to be finished) affect the measurements.
89! If barriers shall not be used at all, a fourth, optional parameter has to be
90! given:
91!
92!     CALL cpu_log( ..., ..., 'start', cpu_log_nowait )
93!
94! Variable log_point should be used for non-overlapping code segments, and they
95! should sum up to the total cpu-time required by the complete run.
96! Variable log_point_s can be used for any other special (s) measurements.
97!------------------------------------------------------------------------------!
98
99    USE control_parameters,                                                    &
100        ONLY: message_string, nr_timesteps_this_run, run_description_header,   &
101              synchronous_exchange
102               
103    USE indices,                                                               &
104        ONLY: nx, ny, nz
105       
106    USE kinds
107   
108    USE pegrid
109
110    IMPLICIT NONE
111
112    PRIVATE
113    PUBLIC   cpu_log, cpu_log_barrierwait, cpu_log_nowait, cpu_statistics,     &
114             initial_wallclock_time, log_point, log_point_s
115
116    INTERFACE cpu_log
117       MODULE PROCEDURE cpu_log
118    END INTERFACE cpu_log
119
120    INTERFACE cpu_statistics
121       MODULE PROCEDURE cpu_statistics
122    END INTERFACE cpu_statistics
123
124    INTEGER(iwp), PARAMETER ::  cpu_log_continue = 0  !:
125    INTEGER(iwp), PARAMETER ::  cpu_log_pause = 1     !:
126    INTEGER(iwp), PARAMETER ::  cpu_log_start = 2     !:
127    INTEGER(iwp), PARAMETER ::  cpu_log_stop = 3      !:
128
129    LOGICAL            ::  cpu_log_barrierwait = .FALSE.  !:
130    LOGICAL, PARAMETER ::  cpu_log_nowait = .FALSE.       !:
131
132    REAL(wp) ::  initial_wallclock_time  !:
133
134    TYPE logpoint
135       REAL(wp)           ::  isum       !:
136       REAL(wp)           ::  ivect      !:
137       REAL(wp)           ::  mean       !:
138       REAL(wp)           ::  mtime      !:
139       REAL(wp)           ::  mtimevec   !:
140       REAL(wp)           ::  sum        !:
141       REAL(wp)           ::  vector     !:
142       INTEGER(iwp)       ::  counts     !:
143       CHARACTER (LEN=20) ::  place      !:
144    END TYPE logpoint
145
146    TYPE(logpoint), DIMENSION(100) ::  log_point = logpoint( 0.0_wp, 0.0_wp,   &
147                                       0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
148                                       0, ' ' ),                               &
149                                       log_point_s = logpoint( 0.0_wp, 0.0_wp, &
150                                       0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, &
151                                       0, ' ' )
152
153    SAVE
154
155 CONTAINS
156
157    SUBROUTINE cpu_log( log_event, place, modus, barrierwait )
158
159       IMPLICIT NONE
160
161       CHARACTER (LEN=*) ::  modus              !:
162       CHARACTER (LEN=*) ::  place              !:
163       
164       LOGICAL           ::  wait_allowed       !:
165       LOGICAL, OPTIONAL ::  barrierwait        !:
166       LOGICAL, SAVE     ::  first = .TRUE.     !:
167       
168       REAL(wp)          ::  mtime = 0.0_wp     !:
169       REAL(wp)          ::  mtimevec = 0.0_wp  !:
170       TYPE(logpoint)    ::  log_event          !:
171
172#if defined( __lc ) || defined( __decalpha )
173       INTEGER(idp)     ::  count        !:
174       INTEGER(idp)     ::  count_rate   !:
175#elif defined( __nec )
176       INTEGER(iwp)      ::  count       !:
177       INTEGER(iwp)      ::  count_rate  !:
178#elif defined( __ibm )
179       INTEGER(idp)     ::  IRTC         !:
180#endif
181
182
183!
184!--    Initialize and check, respectively, point of measurement
185       IF ( log_event%place == ' ' )  THEN
186          log_event%place = place
187       ELSEIF ( log_event%place /= place )  THEN
188          WRITE( message_string, * ) 'wrong argument & expected: ',            &
189                            TRIM(log_event%place), '  given: ',  TRIM( place )
190          CALL message( 'cpu_log', 'PA0174', 1, 2, 0, 6, 0 )
191       ENDIF
192
193!
194!--    Determine, if barriers are allowed to set
195       IF ( PRESENT( barrierwait ) )  THEN
196          wait_allowed = barrierwait
197       ELSE
198          wait_allowed = .TRUE.
199       ENDIF
200
201!
202!--    MPI barrier, if requested, in order to avoid measuring wait times
203!--    caused by MPI routines waiting for other MPI routines of other
204!--    PEs that have not yet finished
205#if defined( __parallel )
206       IF ( cpu_log_barrierwait  .AND.  wait_allowed  .AND.                    &
207            ( modus == 'start'  .OR.  modus == 'continue' ) )  THEN
208          CALL MPI_BARRIER( comm2d, ierr )
209       ENDIF
210#endif
211
212!
213!--    Take current time
214#if defined( __lc ) || defined( __decalpha ) || defined( __nec )
215       CALL SYSTEM_CLOCK( count, count_rate )
216       mtime = REAL( count, KIND=wp ) / REAL( count_rate, KIND=wp )
217#elif defined( __ibm )
218       mtime = IRTC( ) * 1E-9_wp
219#else
220       message_string = 'no time measurement defined on this host'
221       CALL message( 'cpu_log', 'PA0175', 1, 2, 0, 6, 0 )
222#endif
223
224!
225!--    Start, stop or pause measurement
226       IF ( modus == 'start'  .OR.  modus == 'continue' )  THEN
227          log_event%mtime    = mtime
228          log_event%mtimevec = mtimevec
229       ELSEIF ( modus == 'pause' )  THEN
230          IF ( ( mtime - log_event%mtime ) < 0.0  .AND.  first )  THEN
231             WRITE( message_string, * ) 'negative time interval occured',      &
232                         ' &PE',myid,' L=PAUSE "',TRIM(log_event%place),       &
233                         '" new=', mtime,' last=',log_event%mtime
234             CALL message( 'cpu_log', 'PA0176', 0, 1, -1, 6, 0 )
235             first = .FALSE.
236          ENDIF
237          log_event%isum     = log_event%isum + mtime - log_event%mtime
238          log_event%ivect    = log_event%ivect  + mtimevec - log_event%mtimevec
239       ELSEIF ( modus == 'stop' )  THEN
240          IF ( ( mtime - log_event%mtime + log_event%isum ) < 0.0  .AND.       &
241               first )  THEN
242             WRITE( message_string, * ) 'negative time interval occured',      &
243                         ' &PE',myid,' L=STOP "',TRIM(log_event%place),'" new=', &
244                         mtime,' last=',log_event%mtime,' isum=',log_event%isum
245             CALL message( 'cpu_log', 'PA0177', 0, 1, -1, 6, 0 )
246             first = .FALSE.
247          ENDIF
248          log_event%mtime    = mtime    - log_event%mtime    + log_event%isum
249          log_event%mtimevec = mtimevec - log_event%mtimevec + log_event%ivect
250          log_event%sum      = log_event%sum  + log_event%mtime
251          IF ( log_event%sum < 0.0  .AND.  first )  THEN
252             WRITE( message_string, * ) 'negative time interval occured',      &
253                         ' &PE',myid,' L=STOP "',TRIM(log_event%place),'" sum=', &
254                                         log_event%sum,' mtime=',log_event%mtime
255             CALL message( 'cpu_log', 'PA0178', 0, 1, -1, 6, 0 )
256             first = .FALSE.
257          ENDIF
258          log_event%vector   = log_event%vector + log_event%mtimevec
259          log_event%counts   = log_event%counts + 1
260          log_event%isum     = 0.0_wp
261          log_event%ivect    = 0.0_wp
262       ELSE
263          message_string = 'unknown modus of time measurement: ' // TRIM( modus )
264          CALL message( 'cpu_log', 'PA0179', 0, 1, -1, 6, 0 )
265       ENDIF
266
267    END SUBROUTINE cpu_log
268
269
270    SUBROUTINE cpu_statistics
271!------------------------------------------------------------------------------!
272! Description:
273! ------------
274! Analysis and output of the cpu-times measured. All PE results are collected
275! on PE0 in order to calculate the mean cpu-time over all PEs and other
276! statistics. The output is sorted according to the amount of cpu-time consumed
277! and output on PE0.
278!------------------------------------------------------------------------------!
279
280       IMPLICIT NONE
281
282       INTEGER(iwp)    ::  i               !:
283       INTEGER(iwp)    ::  ii(1)           !:
284       INTEGER(iwp)    ::  iii             !:
285       INTEGER(iwp)    ::  sender          !:
286       REAL(wp)       ::  average_cputime  !:
287       REAL(wp), SAVE ::  norm = 1.0_wp    !:
288       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  pe_max        !:
289       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  pe_min        !:
290       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  pe_rms        !:
291       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  sum           !:
292       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  pe_log_points !:
293
294
295!
296!--    Compute cpu-times in seconds
297       log_point%mtime  = log_point%mtime  / norm
298       log_point%sum    = log_point%sum    / norm
299       log_point%vector = log_point%vector / norm
300       WHERE ( log_point%counts /= 0 )
301          log_point%mean = log_point%sum / log_point%counts
302       END WHERE
303
304
305!
306!--    Collect cpu-times from all PEs and calculate statistics
307       IF ( myid == 0 )  THEN
308!
309!--       Allocate and initialize temporary arrays needed for statistics
310          ALLOCATE( pe_max( SIZE( log_point ) ), pe_min( SIZE( log_point ) ),  &
311                    pe_rms( SIZE( log_point ) ),                               &
312                    pe_log_points( SIZE( log_point ), 0:numprocs-1 ) )
313          pe_min = log_point%sum
314          pe_max = log_point%sum    ! need to be set in case of 1 PE
315          pe_rms = 0.0_wp
316
317#if defined( __parallel )
318!
319!--       Receive data from all PEs
320          DO  i = 1, numprocs-1
321             CALL MPI_RECV( pe_max(1), SIZE( log_point ), MPI_REAL,            &
322                            i, i, comm2d, status, ierr )
323             sender = status(MPI_SOURCE)
324             pe_log_points(:,sender) = pe_max
325          ENDDO
326          pe_log_points(:,0) = log_point%sum   ! Results from PE0
327!
328!--       Calculate mean of all PEs, store it on log_point%sum
329!--       and find minimum and maximum
330          DO  iii = 1, SIZE( log_point )
331             DO  i = 1, numprocs-1
332                log_point(iii)%sum = log_point(iii)%sum + pe_log_points(iii,i)
333                pe_min(iii) = MIN( pe_min(iii), pe_log_points(iii,i) )
334                pe_max(iii) = MAX( pe_max(iii), pe_log_points(iii,i) )
335             ENDDO
336             log_point(iii)%sum = log_point(iii)%sum / numprocs
337!
338!--          Calculate rms
339             DO  i = 0, numprocs-1
340                pe_rms(iii) = pe_rms(iii) + (                                  &
341                                    pe_log_points(iii,i) - log_point(iii)%sum  &
342                                            )**2
343             ENDDO
344             pe_rms(iii) = SQRT( pe_rms(iii) / numprocs )
345          ENDDO
346       ELSE
347!
348!--       Send data to PE0 (pe_max is used as temporary storage to send
349!--       the data in order to avoid sending the data type log)
350          ALLOCATE( pe_max( SIZE( log_point ) ) )
351          pe_max = log_point%sum
352          CALL MPI_SEND( pe_max(1), SIZE( log_point ), MPI_REAL, 0, myid, comm2d, &
353                         ierr )
354#endif
355
356       ENDIF
357
358!
359!--    Write cpu-times
360       IF ( myid == 0 )  THEN
361!
362!--       Re-store sums
363          ALLOCATE( sum( SIZE( log_point ) ) )
364          WHERE ( log_point%counts /= 0 )
365             sum = log_point%sum
366          ELSEWHERE
367             sum = -1.0_wp
368          ENDWHERE
369
370!
371!--       Get total time in order to calculate CPU-time per gridpoint and timestep
372          IF ( nr_timesteps_this_run /= 0 )  THEN
373             average_cputime = log_point(1)%sum / REAL( (nx+1) * (ny+1) * nz, KIND=wp ) / &
374                               REAL( nr_timesteps_this_run, KIND=wp ) * 1E6_wp  ! in micro-sec
375          ELSE
376             average_cputime = -1.0_wp
377          ENDIF
378
379!
380!--       Write cpu-times sorted by size
381          CALL check_open( 18 )
382#if defined( __parallel )
383          WRITE ( 18, 100 )  TRIM( run_description_header ),                          &
384                             numprocs * threads_per_task, pdims(1), pdims(2),         &
385                             threads_per_task, nx+1, ny+1, nz, nr_timesteps_this_run, &
386                             average_cputime
387
388          IF ( num_acc_per_node /= 0 )  WRITE ( 18, 108 )  num_acc_per_node
389          WRITE ( 18, 110 )
390#else
391          WRITE ( 18, 100 )  TRIM( run_description_header ),                          &
392                             numprocs * threads_per_task, 1, 1,                       &
393                             threads_per_task, nx+1, ny+1, nz, nr_timesteps_this_run, &
394                             average_cputime
395
396          IF ( num_acc_per_node /= 0 )  WRITE ( 18, 109 )  num_acc_per_node
397          WRITE ( 18, 110 )
398#endif
399          DO
400             ii = MAXLOC( sum )
401             i = ii(1)
402             IF ( sum(i) /= -1.0_wp )  THEN
403                WRITE ( 18, 102 ) &
404              log_point(i)%place, log_point(i)%sum,                            &
405                   log_point(i)%sum / log_point(1)%sum * 100.0_wp,             &
406                   log_point(i)%counts, pe_min(i), pe_max(i), pe_rms(i)
407                sum(i) = -1.0_wp
408             ELSE
409                EXIT
410             ENDIF
411          ENDDO
412       ENDIF
413
414
415!
416!--    The same procedure again for the individual measurements.
417!
418!--    Compute cpu-times in seconds
419       log_point_s%mtime  = log_point_s%mtime  / norm
420       log_point_s%sum    = log_point_s%sum    / norm
421       log_point_s%vector = log_point_s%vector / norm
422       WHERE ( log_point_s%counts /= 0 )
423          log_point_s%mean = log_point_s%sum / log_point_s%counts
424       END WHERE
425
426!
427!--    Collect cpu-times from all PEs and calculate statistics
428#if defined( __parallel )
429!
430!--    Set barrier in order to avoid that PE0 receives log_point_s-data
431!--    while still busy with receiving log_point-data (see above)
432       CALL MPI_BARRIER( comm2d, ierr )
433#endif
434       IF ( myid == 0 )  THEN
435!
436!--       Initialize temporary arrays needed for statistics
437          pe_min = log_point_s%sum
438          pe_max = log_point_s%sum    ! need to be set in case of 1 PE
439          pe_rms = 0.0_wp
440
441#if defined( __parallel )
442!
443!--       Receive data from all PEs
444          DO  i = 1, numprocs-1
445             CALL MPI_RECV( pe_max(1), SIZE( log_point ), MPI_REAL, &
446                            MPI_ANY_SOURCE, MPI_ANY_TAG, comm2d, status, ierr )
447             sender = status(MPI_SOURCE)
448             pe_log_points(:,sender) = pe_max
449          ENDDO
450          pe_log_points(:,0) = log_point_s%sum   ! Results from PE0
451!
452!--       Calculate mean of all PEs, store it on log_point_s%sum
453!--       and find minimum and maximum
454          DO  iii = 1, SIZE( log_point )
455             DO  i = 1, numprocs-1
456                log_point_s(iii)%sum = log_point_s(iii)%sum + pe_log_points(iii,i)
457                pe_min(iii) = MIN( pe_min(iii), pe_log_points(iii,i) )
458                pe_max(iii) = MAX( pe_max(iii), pe_log_points(iii,i) )
459             ENDDO
460             log_point_s(iii)%sum = log_point_s(iii)%sum / numprocs
461!
462!--          Calculate rms
463             DO  i = 0, numprocs-1
464                pe_rms(iii) = pe_rms(iii) + (                                  &
465                                    pe_log_points(iii,i) - log_point_s(iii)%sum &
466                                            )**2
467             ENDDO
468             pe_rms(iii) = SQRT( pe_rms(iii) / numprocs )
469          ENDDO
470       ELSE
471!
472!--       Send data to PE0 (pe_max is used as temporary storage to send
473!--       the data in order to avoid sending the data type log)
474          pe_max = log_point_s%sum
475          CALL MPI_SEND( pe_max(1), SIZE( log_point ), MPI_REAL, 0, 0, comm2d, &
476                         ierr )
477#endif
478
479       ENDIF
480
481!
482!--    Write cpu-times
483       IF ( myid == 0 )  THEN
484!
485!--       Re-store sums
486          WHERE ( log_point_s%counts /= 0 )
487             sum = log_point_s%sum
488          ELSEWHERE
489             sum = -1.0_wp
490          ENDWHERE
491
492!
493!--       Write cpu-times sorted by size
494          WRITE ( 18, 101 )
495          DO
496             ii = MAXLOC( sum )
497             i = ii(1)
498             IF ( sum(i) /= -1.0_wp )  THEN
499                WRITE ( 18, 102 )                                              &
500                   log_point_s(i)%place, log_point_s(i)%sum,                   &
501                   log_point_s(i)%sum / log_point(1)%sum * 100.0_wp,           &
502                   log_point_s(i)%counts, pe_min(i), pe_max(i), pe_rms(i)
503                sum(i) = -1.0_wp
504             ELSE
505                EXIT
506             ENDIF
507          ENDDO
508
509!
510!--       Output of handling of MPI operations
511          IF ( collective_wait )  THEN
512             WRITE ( 18, 103 )
513          ELSE
514             WRITE ( 18, 104 )
515          ENDIF
516          IF ( cpu_log_barrierwait )  WRITE ( 18, 111 )
517          IF ( synchronous_exchange )  THEN
518             WRITE ( 18, 105 )
519          ELSE
520             WRITE ( 18, 106 )
521          ENDIF
522
523!
524!--       Empty lines in order to create a gap to the results of the model
525!--       continuation runs
526          WRITE ( 18, 107 )
527
528!
529!--       Unit 18 is not needed anymore
530          CALL close_file( 18 )
531
532       ENDIF
533
534
535   100 FORMAT (A/11('-')//'CPU measures for ',I5,' PEs (',I5,'(x) * ',I5,'(y', &
536               &') tasks *',I5,' threads):'//                                  &
537               'gridpoints (x/y/z): ',20X,I5,' * ',I5,' * ',I5/                &
538               'nr of timesteps: ',22X,I6/                                     &
539               'cpu time per grid point and timestep: ',5X,F8.5,' * 10**-6 s')
540
541   101 FORMAT (/'special measures:'/ &
542               &'-----------------------------------------------------------', &
543               &'--------------------')
544
545   102 FORMAT (A20,2X,F9.3,2X,F7.2,1X,I7,3(1X,F9.3))
546   103 FORMAT (/'Barriers are set in front of collective operations')
547   104 FORMAT (/'No barriers are set in front of collective operations')
548   105 FORMAT (/'Exchange of ghostpoints via MPI_SENDRCV')
549   106 FORMAT (/'Exchange of ghostpoints via MPI_ISEND/MPI_IRECV')
550   107 FORMAT (//)
551   108 FORMAT ('Accelerator boards per node: ',14X,I2)
552   109 FORMAT ('Accelerator boards: ',23X,I2)
553   110 FORMAT ('----------------------------------------------------------',   &
554               &'------------'//&
555               &'place:                        mean        counts      min  ', &
556               &'     max       rms'/ &
557               &'                           sec.      %                sec. ', &
558               &'     sec.      sec.'/  &
559               &'-----------------------------------------------------------', &
560               &'-------------------')
561   111 FORMAT (/'Barriers are set at beginning (start/continue) of measurements')
562
563    END SUBROUTINE cpu_statistics
564
565 END MODULE cpulog
Note: See TracBrowser for help on using the repository browser.