psmile_timer.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2010, CERFACS, Toulouse, France.
00003 ! Copyright 2010, DKRZ, Hamburg, Germany.
00004 ! All rights reserved. Use is subject to OASIS4 license terms.
00005 !-----------------------------------------------------------------------
00006 !
00007 ! !DESCRIPTION:
00008 !
00009 ! Module psmile_timer contains functionallity, which can be used to
00010 ! measure the time consumed in specific parts of the code.
00011 !
00012 ! Available routines:
00013 !  psmile_timer_init         allocates timers
00014 !  psmile_timer_start        starts specific timer
00015 !  psmile_timer_stop         stops specific timer and sums up measured time intervals
00016 !  psmile_timer_reset        resets specific timer
00017 !  psmile_timer_print        root process prints all timers of all processes sharing
00018 !                            the same mpi communicator provided to psmile_timer_init
00019 !                            in addition it frees all memory allocated by timers
00020 !
00021 !
00022 ! !REVISION HISTORY:
00023 !
00024 !   Date      Programmer   Description
00025 ! ----------  ----------   -----------
00026 ! 03.01.11    M. Hanke     created (based on psmile_timer.F90 and
00027 !                                   prismdrv_timer.F90 from SV and JL)
00028 !
00029 !----------------------------------------------------------------------
00030 !
00031 !  $Id: psmile_timer.F90 2849 2011-01-05 08:14:13Z hanke $
00032 !  $Author: hanke $
00033 !
00034 !----------------------------------------------------------------------
00035 
00036 module psmile_timer
00037 
00038    use psmile_common
00039    use prism_constants, only : prism_error_alloc, prism_error_invalid_arg
00040 
00041    implicit none
00042 
00043    ! name of the application
00044    character (len=max_name) :: app_name
00045 
00046    ! Communicator for which this timer is valid
00047    integer :: comm_timer
00048 
00049    ! size of the communicator
00050    integer :: comm_size
00051 
00052    ! rank of the local process within the communicator
00053    integer :: comm_rank
00054 
00055    ! name of the time statistics file
00056    character (len=max_name) :: file_name
00057 
00058    type timer_details
00059 
00060       ! label of timer
00061       character (len=max_name) :: label
00062 
00063       ! wall time values
00064       double precision :: start_wtime, end_wtime
00065 
00066       ! cpu time values
00067       real :: start_ctime, end_ctime
00068    end type timer_details
00069 
00070    type (timer_details), allocatable :: timer (:)
00071    real, allocatable                 :: sum_ctime(:) ! these values are not part of timer details
00072    double precision, allocatable     :: sum_wtime(:) ! because they are later used in an mpi call
00073 
00074    contains
00075 
00076 ! --------------------------------------------------------------------------------
00077 
00078       subroutine psmile_timer_init (num_timer, timer_label, app, file, comm)
00079 
00080          integer, intent (in)                  :: num_timer
00081          character (len=max_name), intent (in) :: timer_label(num_timer)
00082          character (len=*), intent (in)        :: app
00083          character (len=*), intent (in)        :: file
00084          integer, intent (in)                  :: comm
00085 
00086          integer :: ierror
00087 
00088 #ifdef PRISM_ASSERTION
00089          if (num_timer < 1) then
00090             call psmile_error_common ( prism_error_invalid_arg, 'num_timer', &
00091                   (/0/), 1, __FILE__, __LINE__ )
00092             return
00093          endif
00094 #endif
00095 
00096          app_name  = trim (app)
00097          file_name = trim (file)
00098 
00099          ! allocate and initialise all timer
00100          allocate (timer (num_timer), sum_wtime(num_timer), sum_ctime(num_timer), stat=ierror)
00101 
00102          if ( ierror /= 0 ) then
00103             call psmile_error_common ( prism_error_alloc, 'timer, sum_wtime, sum_ctime', &
00104                   (/0, num_timer/), 2, __FILE__, __LINE__ )
00105             return
00106          endif
00107 
00108          timer(:)%label       = timer_label
00109          timer(:)%start_wtime = 0
00110          timer(:)%end_wtime   = 0
00111          timer(:)%start_ctime = 0
00112          timer(:)%end_ctime   = 0
00113 
00114          sum_wtime(:)         = 0
00115          sum_ctime(:)         = 0
00116 
00117          ! initialise MPI specific data
00118          comm_timer = comm
00119 
00120          call MPI_Comm_size(comm, comm_size, ierror)
00121          call MPI_Comm_rank(comm, comm_rank, ierror)
00122 
00123 #ifdef VERBOSE
00124       print *, '| | timers initialised in processor : ', comm_rank
00125       call psmile_flushstd
00126 #endif
00127 
00128       end subroutine psmile_timer_init
00129 
00130 ! --------------------------------------------------------------------------------
00131 
00132       subroutine psmile_timer_start (timer_id)
00133 
00134          integer, intent (in) :: timer_id
00135 
00136 #ifdef PRISM_ASSERTION
00137          if (.not. allocated (timer)) then
00138             call psmile_error_common ( prism_error_invalid_arg, 'timer_id', &
00139                   (/0/), 1, __FILE__, __LINE__ )
00140             return
00141          else if (timer_id < 1 .and. timer_id > size (timer)) then
00142             call psmile_error_common ( prism_error_invalid_arg, 'timer_id', &
00143                   (/0/), 1, __FILE__, __LINE__ )
00144             return
00145          endif
00146 #endif
00147 
00148          timer(timer_id)%start_wtime = MPI_Wtime()
00149          call cpu_time(timer(timer_id)%start_ctime)
00150 
00151       end subroutine psmile_timer_start
00152 
00153 ! --------------------------------------------------------------------------------
00154 
00155       subroutine psmile_timer_stop (timer_id)
00156 
00157          integer, intent (in) :: timer_id
00158 
00159 #ifdef PRISM_ASSERTION
00160          if (.not. allocated (timer)) then
00161             call psmile_error_common ( prism_error_invalid_arg, 'timer_id', &
00162                   (/0/), 1, __FILE__, __LINE__ )
00163             return
00164          else if (timer_id < 1 .and. timer_id > size (timer)) then
00165             call psmile_error_common ( prism_error_invalid_arg, 'timer_id', &
00166                   (/0/), 1, __FILE__, __LINE__ )
00167             return
00168          endif
00169 #endif
00170 
00171          timer(timer_id)%end_wtime = MPI_Wtime()
00172          call cpu_time(timer(timer_id)%end_ctime)
00173 
00174          sum_wtime(timer_id) = sum_wtime(timer_id) + &
00175                                timer(timer_id)%end_wtime - timer(timer_id)%start_wtime
00176          sum_ctime(timer_id) = sum_ctime(timer_id) + &
00177                                timer(timer_id)%end_ctime - timer(timer_id)%start_ctime
00178 
00179       end subroutine psmile_timer_stop
00180 
00181 ! --------------------------------------------------------------------------------
00182 
00183       subroutine psmile_timer_reset (timer_id)
00184 
00185          integer, intent (in) :: timer_id
00186 
00187 #ifdef PRISM_ASSERTION
00188          if (.not. allocated (timer)) then
00189             call psmile_error_common ( prism_error_invalid_arg, 'timer_id', &
00190                   (/0/), 1, __FILE__, __LINE__ )
00191             return
00192          else if (timer_id < 1 .and. timer_id > size (timer)) then
00193             call psmile_error_common ( prism_error_invalid_arg, 'timer_id', &
00194                   (/0/), 1, __FILE__, __LINE__ )
00195             return
00196          endif
00197 #endif
00198 
00199          timer(timer_id)%start_wtime = 0
00200          timer(timer_id)%start_ctime = 0
00201 
00202          timer(timer_id)%end_wtime = 0
00203          timer(timer_id)%end_ctime = 0
00204 
00205          sum_wtime(timer_id) = 0
00206          sum_ctime(timer_id) = 0
00207 
00208       end subroutine psmile_timer_reset
00209 
00210 ! --------------------------------------------------------------------------------
00211 
00212       subroutine psmile_timer_print
00213 
00214          real, allocatable             :: sum_ctime_global(:,:)
00215          double precision, allocatable :: sum_wtime_global(:,:)
00216 
00217 
00218          ! Fortran Unit for output time statistics
00219          integer, parameter :: output_unit = 901
00220          integer, parameter :: root = 0
00221          integer            :: k, n
00222          integer            :: ierror
00223 
00224 #ifdef PRISM_ASSERTION
00225          if (.not. allocated (timer)) &
00226             call psmile_error_common ( -1, 'psmile_timer_init was not called', &
00227                   (/-1/), 1, __FILE__, __LINE__ )
00228 #endif
00229 
00230          allocate (sum_ctime_global(size (timer), comm_size), &
00231                    sum_wtime_global(size (timer), comm_size), stat=ierror)
00232 
00233          if ( ierror /= 0 ) then
00234             call psmile_error_common ( prism_error_alloc, 'sum_ctime_global, sum_wtime_global', &
00235                   (/0, 2*(comm_size*size (timer))/), 2, __FILE__, __LINE__ )
00236             return
00237          endif
00238 
00239          ! gathering of timer values on root process
00240 
00241          ! if there is more than one process in comm_timer
00242          if (comm_size > 1) then
00243 
00244             print *,' Calling MPI_Gather for CPU time in psmile_timer_print, num_timer = ', size (timer)
00245 
00246             call MPI_Gather(sum_ctime(1), size (timer), MPI_REAL, sum_ctime_global(1,1), &
00247                             size (timer), MPI_REAL, root, comm_timer, ierror)
00248             print *,' error code for MPI_Gather = ', ierror
00249 
00250             print *,' Calling MPI_Gather for elaps time in psmile_timer_print, num_timer = ', size (timer)
00251 
00252             call MPI_Gather(sum_wtime(1), size (timer), MPI_DOUBLE_PRECISION, sum_wtime_global(1,1), &
00253                             size (timer), MPI_DOUBLE_PRECISION, root, comm_timer, ierror)
00254 
00255             print *, ' error code for MPI_Gather = ', ierror
00256 
00257          else
00258 
00259             sum_ctime_global(:,1) = sum_ctime(:)
00260             sum_wtime_global(:,1) = sum_wtime(:)
00261 
00262          endif ! (comm_size > 1)
00263 
00264          ! if this is the root process
00265          if (comm_rank == root) then
00266 
00267             print *,' Root (process 0) has received timer values from all processes '
00268             open(output_unit, file=trim(file_name), form="FORMATTED", status="UNKNOWN")
00269 
00270             write(output_unit,*)' =================================='
00271             write(output_unit,*)' ', trim(app_name)
00272             write(output_unit,*)' Overall CPU time statistics'
00273             write(output_unit,*)' =================================='
00274             write(output_unit,*)''
00275             write(output_unit,'(a)',advance="NO") " P r o c e s s o r s   ----------> "
00276             write(output_unit,'(8(3x,i2,5x))')(k,k=1,comm_size)
00277             do n = 1, size (timer)
00278 
00279                WRITE(output_unit,'(1x,i3,2x,a24,2x,(8f10.4))') n, timer(n)%label, &
00280                                                                (sum_ctime_global(n,k),k=1,comm_size)
00281             enddo
00282             write(output_unit,*)''
00283             write(output_unit,*)' ======================================'
00284             write(output_unit,*)' ', trim(app_name)
00285             write(output_unit,*)' Overall Elapsed time statistics'
00286             write(output_unit,*)' ======================================'
00287             write(output_unit,*)''
00288             write(output_unit,'(a)',advance="NO") " P r o c e s s o r s   ----------> "
00289             write(output_unit,'(8(3x,i2,5x))')(k,k=1,comm_size)
00290             do n = 1, size (timer)
00291 
00292                WRITE(output_unit,'(1x,i3,2x,a24,2x,(8f10.4))') n, timer(n)%label, &
00293                                                                (sum_wtime_global(n,k),k=1,comm_size)
00294             enddo
00295             write(output_unit,*)''
00296             write(output_unit,*)' ======================================'
00297 
00298             close(output_unit)
00299 
00300          endif ! (comm_rank == root)
00301 
00302          deallocate (sum_ctime_global, sum_wtime_global)
00303 
00304          deallocate (timer, sum_ctime, sum_wtime)
00305 
00306       end subroutine psmile_timer_print
00307 
00308 end module psmile_timer