instrument.f

Go to the documentation of this file.

 
 
      SUBROUTINE instrument(K,KALL,TTOT,TMIN,TMAX)
        IMPLICIT NONE
        INTEGER,INTENT(IN):: K
        INTEGER,INTENT(OUT):: KALL
        REAL,INTENT(OUT):: TTOT,TMIN,TMAX
        INTEGER,SAVE:: KMAX=0
        INTEGER,DIMENSION(:),ALLOCATABLE,SAVE:: KALLS
        REAL,DIMENSION(:),ALLOCATABLE,SAVE:: TTOTS,TMINS,TMAXS
        INTEGER,DIMENSION(8),SAVE:: IDAT
        INTEGER,DIMENSION(8):: JDAT
        REAL,DIMENSION(5):: RINC
        INTEGER:: KA
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        ka=abs(k)
!  ALLOCATE MONITORING ARRAYS IF INITIAL INVOCATION
        IF(kmax.EQ.0) THEN
          kmax=k
          ALLOCATE(kalls(kmax))
          ALLOCATE(ttots(kmax))
          ALLOCATE(tmins(kmax))
          ALLOCATE(tmaxs(kmax))
          kalls=0
          ka=0
!  OR RESET ALL STATISTICS BACK TO ZERO
        ELSEIF(k.EQ.0) THEN
          kalls=0
!  OR COUNT TIME SINCE LAST INVOCATION AGAINST THIS SECTION
        ELSEIF(k.GT.0) THEN
          CALL w3utcdat(jdat)
          CALL w3difdat(jdat,idat,4,rinc)
          kalls(k)=kalls(k)+1
          IF(kalls(k).EQ.1) THEN
            ttots(k)=rinc(4)
            tmins(k)=rinc(4)
            tmaxs(k)=rinc(4)
          ELSE
            ttots(k)=ttots(k)+rinc(4)
            tmins(k)=min(tmins(k),rinc(4))
            tmaxs(k)=max(tmaxs(k),rinc(4))
          ENDIF
        ENDIF
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  RETURN STATISTICS
 
!  FRIMEL and KALINA, DECOMPOSE THE IF STATEMENT, SAFER FOR SOME
!  COMPILERS. Since No Guarantee on order of evaluation, and when
!  evaluation will stop.
!  MAKE SURE KA.GE.1 BEFORE TESTING IF KALLS(KA).GT.0, ELSE
!  MAY ENCOUNTER A RUNTIME SIGSEGV SEGEMENTATION FAULT.
!  Since  Subscript #1 of the array KALLS can have value 0 which
!  is less than the lower bound of 1
!        IF(KA.GE.1.AND.KA.LE.KMAX.AND.KALLS(KA).GT.0) THEN
 
        IF(ka.GE.1.AND.ka.LE.kmax) THEN
          IF(kalls(ka).GT.0) THEN
            kall=kalls(ka)
            ttot=ttots(ka)
            tmin=tmins(ka)
            tmax=tmaxs(ka)
          ENDIF
          IF(kalls(ka).LE.0) THEN
            kall=0
            ttot=0
            tmin=0
            tmax=0
          ENDIF
       END IF
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  KEEP CURRENT TIME FOR NEXT INVOCATION
        IF(k.GE.0) CALL w3utcdat(idat)
      END SUBROUTINE instrument