source: palm/tags/release-3.2/SOURCE/cpu_statistics.f90 @ 4418

Last change on this file since 4418 was 4, checked in by raasch, 17 years ago

Id keyword set as property for all *.f90 files

  • Property svn:keywords set to Id
File size: 8.4 KB
Line 
1 SUBROUTINE cpu_statistics
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: cpu_statistics.f90 4 2007-02-13 11:33:16Z raasch $
11! RCS Log replace by Id keyword, revision history cleaned up
12!
13! Revision 1.13  2006/04/26 12:10:51  raasch
14! Output of number of threads per task, max = min in case of 1 PE
15!
16! Revision 1.1  1997/07/24 11:11:11  raasch
17! Initial revision
18!
19!
20! Description:
21! ------------
22! Analysis and output of the cpu-times measured. All PE results are collected
23! on PE0 in order to calculate the mean cpu-time over all PEs and other
24! statistics. The output is sorted according to the amount of cpu-time consumed
25! and output on PE0.
26!------------------------------------------------------------------------------!
27
28    USE cpulog
29    USE pegrid
30    USE control_parameters
31
32    IMPLICIT NONE
33
34    INTEGER    ::  i, ii(1), iii, lp, sender
35    REAL, SAVE ::  norm = 1.0
36    REAL, DIMENSION(:),   ALLOCATABLE ::  pe_max, pe_min, pe_rms, sum
37    REAL, DIMENSION(:,:), ALLOCATABLE ::  pe_log_points
38
39
40!#if defined( __hpmuk )  &&  ! defined( __chinook )
41!    norm = clock_ticks_per_second()
42!#endif
43
44!
45!-- Compute cpu-times in seconds
46    log_point%mtime  = log_point%mtime  / norm
47    log_point%sum    = log_point%sum    / norm
48    log_point%vector = log_point%vector / norm
49    WHERE ( log_point%counts /= 0 )
50       log_point%mean = log_point%sum / log_point%counts
51    END WHERE
52
53
54!
55!-- Collect cpu-times from all PEs and calculate statistics
56    IF ( myid == 0 )  THEN
57!
58!--    Allocate and initialize temporary arrays needed for statistics
59       ALLOCATE( pe_max( SIZE( log_point ) ), pe_min( SIZE( log_point ) ), &
60                 pe_rms( SIZE( log_point ) ),                              &
61                 pe_log_points( SIZE( log_point ), 0:numprocs-1 ) )
62       pe_min = log_point%sum
63       pe_max = log_point%sum    ! need to be set in case of 1 PE
64       pe_rms = 0.0
65
66#if defined( __parallel )
67!
68!--    Receive data from all PEs
69       DO  i = 1, numprocs-1
70          CALL MPI_RECV( pe_max(1), SIZE( log_point ), MPI_REAL, &
71                         MPI_ANY_SOURCE, MPI_ANY_TAG, comm2d, status, ierr )
72          sender = status(MPI_SOURCE)
73          pe_log_points(:,sender) = pe_max
74       ENDDO
75       pe_log_points(:,0) = log_point%sum   ! Results from PE0
76!
77!--    Calculate mean of all PEs, store it on log_point%sum
78!--    and find minimum and maximum
79       DO  iii = 1, SIZE( log_point )
80          DO  i = 1, numprocs-1
81             log_point(iii)%sum = log_point(iii)%sum + pe_log_points(iii,i)
82             pe_min(iii) = MIN( pe_min(iii), pe_log_points(iii,i) )
83             pe_max(iii) = MAX( pe_max(iii), pe_log_points(iii,i) )
84          ENDDO
85          log_point(iii)%sum = log_point(iii)%sum / numprocs
86!
87!--       Calculate rms
88          DO  i = 0, numprocs-1
89!             IF ( log_point(iii)%place == 'run_control' )  THEN
90!                PRINT*, 'pe_rms=',pe_rms(iii),' plp=',pe_log_points(iii,i), &
91!                        ' lps=',log_point(iii)%sum
92!             ENDIF
93             pe_rms(iii) = pe_rms(iii) + ( &
94                                 pe_log_points(iii,i) - log_point(iii)%sum &
95                                         )**2
96          ENDDO
97          pe_rms(iii) = SQRT( pe_rms(iii) / numprocs )
98       ENDDO
99    ELSE
100!
101!--    Send data to PE0 (pe_max is used as temporary storage to send
102!--    the data in order to avoid sending the data type log)
103       ALLOCATE( pe_max( SIZE( log_point ) ) )
104       pe_max = log_point%sum
105       CALL MPI_SEND( pe_max(1), SIZE( log_point ), MPI_REAL, 0, 0, comm2d, &
106                      ierr )
107#endif
108
109    ENDIF
110
111!
112!-- Write cpu-times
113    IF ( myid == 0 )  THEN
114!
115!--    Re-store sums
116       ALLOCATE( sum( SIZE( log_point ) ) )
117       WHERE ( log_point%counts /= 0 )
118          sum = log_point%sum
119       ELSEWHERE
120          sum = -1.0
121       ENDWHERE
122
123!
124!--    Write cpu-times sorted by size
125       CALL check_open( 18 )
126       WRITE ( 18, 100 )  TRIM( run_description_header ),        &
127                          numprocs * threads_per_task, numprocs, &
128                          threads_per_task
129       DO
130          ii = MAXLOC( sum )
131          i = ii(1)
132          IF ( sum(i) /= -1.0 )  THEN
133             WRITE ( 18, 102 ) &
134                log_point(i)%place, log_point(i)%sum,                &
135                log_point(i)%sum / log_point(1)%sum * 100.0,         &
136                log_point(i)%counts, pe_min(i), pe_max(i), pe_rms(i)
137             sum(i) = -1.0
138          ELSE
139             EXIT
140          ENDIF
141       ENDDO
142    ENDIF
143
144
145!
146!-- The same procedure again for the individual measurements.
147!
148!-- Compute cpu-times in seconds
149    log_point_s%mtime  = log_point_s%mtime  / norm
150    log_point_s%sum    = log_point_s%sum    / norm
151    log_point_s%vector = log_point_s%vector / norm
152    WHERE ( log_point_s%counts /= 0 )
153       log_point_s%mean = log_point_s%sum / log_point_s%counts
154    END WHERE
155
156!
157!-- Collect cpu-times from all PEs and calculate statistics
158#if defined( __parallel )
159!
160!-- Set barrier in order to avoid that PE0 receives log_point_s-data
161!-- while still busy with receiving log_point-data (see above)
162    CALL MPI_BARRIER( comm2d, ierr )   
163#endif
164    IF ( myid == 0 )  THEN
165!
166!--    Initialize temporary arrays needed for statistics
167       pe_min = log_point_s%sum
168       pe_max = log_point_s%sum    ! need to be set in case of 1 PE
169       pe_rms = 0.0
170
171#if defined( __parallel )
172!
173!--    Receive data from all PEs
174       DO  i = 1, numprocs-1
175          CALL MPI_RECV( pe_max(1), SIZE( log_point ), MPI_REAL, &
176                         MPI_ANY_SOURCE, MPI_ANY_TAG, comm2d, status, ierr )
177          sender = status(MPI_SOURCE)
178          pe_log_points(:,sender) = pe_max
179       ENDDO
180       pe_log_points(:,0) = log_point_s%sum   ! Results from PE0
181!
182!--    Calculate mean of all PEs, store it on log_point_s%sum
183!--    and find minimum and maximum
184       DO  iii = 1, SIZE( log_point )
185          DO  i = 1, numprocs-1
186             log_point_s(iii)%sum = log_point_s(iii)%sum + pe_log_points(iii,i)
187             pe_min(iii) = MIN( pe_min(iii), pe_log_points(iii,i) )
188             pe_max(iii) = MAX( pe_max(iii), pe_log_points(iii,i) )
189          ENDDO
190          log_point_s(iii)%sum = log_point_s(iii)%sum / numprocs
191!
192!--       Calculate rms
193          DO  i = 0, numprocs-1
194             pe_rms(iii) = pe_rms(iii) + ( &
195                                 pe_log_points(iii,i) - log_point_s(iii)%sum &
196                                         )**2
197          ENDDO
198          pe_rms(iii) = SQRT( pe_rms(iii) / numprocs )
199       ENDDO
200    ELSE
201!
202!--    Send data to PE0 (pe_max is used as temporary storage to send
203!--    the data in order to avoid sending the data type log)
204       pe_max = log_point_s%sum
205       CALL MPI_SEND( pe_max(1), SIZE( log_point ), MPI_REAL, 0, 0, comm2d, &
206                      ierr )
207#endif
208
209    ENDIF
210
211!
212!-- Write cpu-times
213    IF ( myid == 0 )  THEN
214!
215!--    Re-store sums
216       WHERE ( log_point_s%counts /= 0 )
217          sum = log_point_s%sum
218       ELSEWHERE
219          sum = -1.0
220       ENDWHERE
221
222!
223!--    Write cpu-times sorted by size
224       WRITE ( 18, 101 )
225       DO
226          ii = MAXLOC( sum )
227          i = ii(1)
228          IF ( sum(i) /= -1.0 )  THEN
229             WRITE ( 18, 102 ) &
230                log_point_s(i)%place, log_point_s(i)%sum, &
231                log_point_s(i)%sum / log_point(1)%sum * 100.0, &
232                log_point_s(i)%counts, pe_min(i), pe_max(i), pe_rms(i)
233             sum(i) = -1.0
234          ELSE
235             EXIT
236          ENDIF
237       ENDDO
238
239!
240!--    Empty lines in order to create a gap to the results of the model
241!--    continuation runs
242       WRITE ( 18, 103 )
243
244!
245!--    Unit 18 is not needed anymore
246       CALL close_file( 18 )
247
248    ENDIF
249
250
251100 FORMAT (A/11('-')//'CPU measures for ',I3,' PEs (',I3,' tasks *',I3,    &
252            &' threads):'/ &
253             &'--------------------------------------------------'//        &
254            &'place:                        mean        counts      min  ', &
255             &'     max       rms'/ &
256            &'                           sec.      %                sec. ', &
257             &'     sec.      sec.'/  &
258            &'-----------------------------------------------------------', &
259             &'-------------------')
260
261101 FORMAT (/'special measures:'/ &
262            &'-----------------------------------------------------------', &
263            &'--------------------')
264
265102 FORMAT (A20,2X,F9.3,2X,F7.2,1X,I7,3(1X,F9.3))
266103 FORMAT (//)
267
268 END SUBROUTINE cpu_statistics
269
Note: See TracBrowser for help on using the repository browser.