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

Last change on this file since 1419 was 1403, checked in by raasch, 10 years ago

last commit documented

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