sltimer.f

Go to the documentation of this file.

      SUBROUTINE SLBOOT()
*
*  -- ScaLAPACK tools routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*  Purpose
*  =======
*
*  SLBOOT (re)sets all timers to 0, and enables SLtimer.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            NTIMER
      PARAMETER          ( NTIMER = 64 )
      DOUBLE PRECISION   STARTFLAG, ZERO
      PARAMETER          ( STARTFLAG = -5.0D+0, ZERO = 0.0D+0 )
*     ..
*     .. Local Scalars ..
      INTEGER            I
*     ..
*     .. Common Blocks ..
      LOGICAL            DISABLED
      DOUBLE PRECISION   CPUSEC( NTIMER ), CPUSTART( NTIMER ),
     $                   WALLSEC( NTIMER ), WALLSTART( NTIMER )
      COMMON /SLTIMER00/ CPUSEC, WALLSEC, CPUSTART, WALLSTART, DISABLED
*     ..
*     .. Executable Statements ..
*
      DISABLED = .FALSE.
      DO 10 I = 1, NTIMER
         CPUSEC( I )  = ZERO
         WALLSEC( I ) = ZERO
         CPUSTART( I )  = STARTFLAG
         WALLSTART( I ) = STARTFLAG
   10 CONTINUE
*
      RETURN
*
*     End of SLBOOT
*
      END
*
      SUBROUTINE SLTIMER( I )
*
*  -- ScaLAPACK tools routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     .. Scalar Arguments ..
      INTEGER            I
*     ..
*
*  Purpose
*  =======
*
*  SLtimer provides a "stopwatch" functionality cpu/wall timer
*  (in seconds).  Up to 64 separate timers can be functioning at once.
*  The first call starts the timer, and the second stops it.  This
*  routine can be disenabled, so that calls to the timer are ignored.
*  This feature can be used to make sure certain sections of code do
*  not affect timings, even if they call routines which have SLtimer
*  calls in them.
*
*  Arguments
*  =========
*
*  I       (global input) INTEGER
*          The timer to stop/start.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            NTIMER
      PARAMETER          ( NTIMER = 64 )
      DOUBLE PRECISION   STARTFLAG
      PARAMETER          ( STARTFLAG = -5.0D+0 )
*     ..
*     .. External Functions ..
      DOUBLE PRECISION   DCPUTIME00, DWALLTIME00
      EXTERNAL           DCPUTIME00, DWALLTIME00
*     ..
*     .. Common Blocks ..
      LOGICAL            DISABLED
      DOUBLE PRECISION   CPUSEC( NTIMER ), CPUSTART( NTIMER ),
     $                   WALLSEC( NTIMER ), WALLSTART( NTIMER )
      COMMON /SLTIMER00/ CPUSEC, WALLSEC, CPUSTART, WALLSTART, DISABLED
*     ..
*     .. Executable Statements ..
*
*     If timing disabled, return
*
      IF( DISABLED )
     $   RETURN
*
      IF( WALLSTART( I ).EQ.STARTFLAG ) THEN
*
*        If timer has not been started, start it
*
         WALLSTART( I ) = DWALLTIME00()
         CPUSTART( I )  = DCPUTIME00()
*
      ELSE
*
*        Stop timer and add interval to count
*
         CPUSEC( I ) = CPUSEC( I ) + DCPUTIME00() - CPUSTART( I )
         WALLSEC( I ) = WALLSEC( I ) + DWALLTIME00() - WALLSTART( I )
         WALLSTART( I ) = STARTFLAG
*
      END IF
*
      RETURN
*
*     End of SLTIMER
*
      END
*
      SUBROUTINE SLENABLE()
*
*  -- ScaLAPACK tools routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*  Purpose
*  =======
*
*  SLENABLE sets it so calls to SLtimer are not ignored.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            NTIMER
      PARAMETER          ( NTIMER = 64 )
*     ..
*     .. Common Blocks ..
      LOGICAL            DISABLED
      DOUBLE PRECISION   CPUSEC( NTIMER ), CPUSTART( NTIMER ),
     $                   WALLSEC( NTIMER ), WALLSTART( NTIMER )
      COMMON /SLTIMER00/ CPUSEC, WALLSEC, CPUSTART, WALLSTART, DISABLED
*     ..
*     .. Executable Statements ..
*
      DISABLED = .FALSE.
*
      RETURN
*
      END
*
      SUBROUTINE SLDISABLE()
*
*  -- ScaLAPACK tools routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*  Purpose
*  =======
*
*  SLDISABLE sets it so calls to SLTIMER are ignored.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            NTIMER
      PARAMETER          ( NTIMER = 64 )
*     ..
*     .. Common Blocks ..
      LOGICAL            DISABLED
      DOUBLE PRECISION   CPUSEC( NTIMER ), CPUSTART( NTIMER ),
     $                   WALLSEC( NTIMER ), WALLSTART( NTIMER )
      COMMON /SLTIMER00/ CPUSEC, WALLSEC, CPUSTART, WALLSTART, DISABLED
*     ..
*     .. Executable Statements ..
*
      DISABLED = .TRUE.
*
      RETURN
*
*     End of SLDISABLE
*
      END
*
      DOUBLE PRECISION FUNCTION SLINQUIRE( TIMETYPE, I )
*
*  -- ScaLAPACK tools routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     .. Scalar Arguments ..
      CHARACTER*1        TIMETYPE
      INTEGER            I
*     ..
*
*  Purpose
*  =======
*
*  SLINQUIRE returns wall or cpu time that has accumulated in timer I.
*
*  Arguments
*  =========
*
*  TIMETYPE (global input) CHARACTER
*           Controls what time will be returned:
*           = 'W': wall clock time is returned,
*           = 'C': CPU time is returned (default).
*
*  I        (global input) INTEGER
*           The timer to return.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            NTIMER
      PARAMETER          ( NTIMER = 64 )
      DOUBLE PRECISION   ERRFLAG
      PARAMETER          ( ERRFLAG = -1.0D+0 )
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION   TIME
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      DOUBLE PRECISION   DCPUTIME00, DWALLTIME00
      EXTERNAL           DCPUTIME00, DWALLTIME00, LSAME
*     ..
*     .. Common Blocks ..
      LOGICAL            DISABLED
      DOUBLE PRECISION   CPUSEC( NTIMER ), CPUSTART( NTIMER ),
     $                   WALLSEC( NTIMER ), WALLSTART( NTIMER )
      COMMON /SLTIMER00/ CPUSEC, WALLSEC, CPUSTART, WALLSTART, DISABLED
*     ..
*     .. Executable Statements ..
*
      IF( LSAME( TIMETYPE, 'W' ) ) THEN
*
*        If walltime not available on this machine, return -1 flag
*
         IF( DWALLTIME00().EQ.ERRFLAG ) THEN
            TIME = ERRFLAG
         ELSE
            TIME = WALLSEC( I )
         END IF
      ELSE
         IF( DCPUTIME00().EQ.ERRFLAG ) THEN
            TIME = ERRFLAG
         ELSE
            TIME = CPUSEC( I )
         END IF
      END IF
*
      SLINQUIRE = TIME
*
      RETURN
*
*     End of SLINQUIRE
*
      END
*
      SUBROUTINE SLCOMBINE( ICTXT, SCOPE, OP, TIMETYPE, N, IBEG,
     $                      TIMES )
*
*  -- ScaLAPACK tools routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     .. Scalar Arguments ..
      CHARACTER          OP, SCOPE, TIMETYPE
      INTEGER            IBEG, ICTXT, N
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION   TIMES( N )
*     ..
*
*  Purpose
*  =======
*
*  SLCOMBINE takes the timing information stored on a scope of processes
*  and combines them into the user's TIMES array.
*
*  Arguments
*  =========
*
*  ICTXT    (local input) INTEGER
*           The BLACS context handle.
*
*  SCOPE    (global input) CHARACTER
*           Controls what processes in grid participate in combine.
*           Options are 'Rowwise', 'Columnwise', or 'All'.
*
*  OP       (global input) CHARACTER
*           Controls what combine should be done:
*           = '>': get maximal time on any process (default),
*           = '<': get minimal time on any process,
*           = '+': get sum of times across processes.
*
*  TIMETYPE (global input) CHARACTER
*           Controls what time will be returned in TIMES:
*           = 'W': wall clock time,
*           = 'C': CPU time (default).
*
*  N        (global input) INTEGER
*           The number of timers to combine.
*
*  IBEG     (global input) INTEGER
*           The first timer to be combined.
*
*  TIMES    (global output) DOUBLE PRECISION array, dimension (N)
*           The requested timing information is returned in this array.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            NTIMER
      PARAMETER          ( NTIMER = 64 )
      DOUBLE PRECISION   ERRFLAG
      PARAMETER          ( ERRFLAG = -1.0D+0 )
*     ..
*     .. Local Scalars ..
      LOGICAL            TMPDIS
      INTEGER            I
*     ..
*     .. External Subroutines ..
      EXTERNAL           DGAMX2D, DGAMN2D, DGSUM2D
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      DOUBLE PRECISION   DCPUTIME00, DWALLTIME00
      EXTERNAL           DCPUTIME00, DWALLTIME00, LSAME
*     ..
*     .. Common Blocks ..
      LOGICAL            DISABLED
      DOUBLE PRECISION   CPUSEC( NTIMER ), CPUSTART( NTIMER ),
     $                   WALLSEC( NTIMER ), WALLSTART( NTIMER )
      COMMON /SLTIMER00/ CPUSEC, WALLSEC, CPUSTART, WALLSTART, DISABLED
*     ..
*     .. Executable Statements ..
*
*     Disable timer for combine operation
*
      TMPDIS = DISABLED
      DISABLED = .TRUE.
*
*     Copy timer information into user's times array
*
      IF( LSAME( TIMETYPE, 'W' ) ) THEN
*
*        If walltime not available on this machine, fill in times
*        with -1 flag, and return
*
         IF( DWALLTIME00().EQ.ERRFLAG ) THEN
            DO 10 I = 1, N
               TIMES( I ) = ERRFLAG
   10       CONTINUE
            RETURN
         ELSE
            DO 20 I = 1, N
               TIMES( I ) = WALLSEC( IBEG + I - 1 )
   20       CONTINUE
         END IF
      ELSE
         IF( DCPUTIME00().EQ.ERRFLAG ) THEN
            DO 30 I = 1, N
               TIMES( I ) = ERRFLAG
   30       CONTINUE
            RETURN
         ELSE
            DO 40 I = 1, N
               TIMES( I ) = CPUSEC( IBEG + I - 1 )
   40       CONTINUE
         END IF
      ENDIF
*
*     Combine all nodes' information, restore disabled, and return
*
      IF( OP.EQ.'>' ) THEN
         CALL DGAMX2D( ICTXT, SCOPE, ' ', N, 1, TIMES, N, -1, -1,
     $                 -1, -1, 0 )
      ELSE IF( OP.EQ.'<' ) THEN
         CALL DGAMN2D( ICTXT, SCOPE, ' ', N, 1, TIMES, N, -1, -1,
     $                 -1, -1, 0 )
      ELSE IF( OP.EQ.'+' ) THEN
         CALL DGSUM2D( ICTXT, SCOPE, ' ', N, 1, TIMES, N, -1, 0 )
      ELSE
         CALL DGAMX2D( ICTXT, SCOPE, ' ', N, 1, TIMES, N, -1, -1,
     $                 -1, -1, 0 )
      END IF
*
      DISABLED = TMPDIS
*
      RETURN
*
*     End of SLCOMBINE
*
      END