C+ C C EXECUTION PROFILER C C ***** IF COMPILED WITH FORTRAN IV, USE THE /-VA SWITCH !!! ***** C C USAGE: C CALL TIMEON - START TIMER(S) C CALL TIMEOF - STOP TIMER(S) AND OPTIONALLY PRINT STATISTICS C CALL TIMCAL(NSUB) - START SUBROUTINE TIMER AND PRINT ENTRY MESSAGE C CALL TIMRET(NSUB) - STOP SUBROUTINE TIMER AND PRINT EXIT MESSAGE C CALL TIMCL(NSUB) - START SUBROUTINE TIMER (NO MSG) C CALL TIMRT(NSUB) - STOP SUBROUTINE TIMER (NO MSG) C C WHERE: C NSUB = SUBROUTINE NUMBER (MAIN IS ALWAYS 1) C C C THE FOLLOWING COMMONS SHOULD BE DECLARED IN THE ROOT OF THE USER PROGRAM: C ( * INDICATES THAT USER-INITIALIZATION IS NECESSARY) C C COMMON /TIMCOM/ LUN, NSUBS, NSTAK C C * LUN I*2 UNIT NUMBER OF TRACING/REPORTING FILE C (MAY BE CHANGED AT WILL DURING EXECUTION. C PROGRAM MUST HAVE A FORMATTED OUTPUT FILE OPEN IF C > 0. IF <= 0, NO TRACING/REPORTING WILL BE DONE) C * NSUBS I*2 MAXIMUM NUMBER OF SUBROUTINES C * NSTAK I*2 MAXIMUM SUBROUTINE NESTING DEPTH C C COMMON /TIMCM0/ CPUTIM C REAL CPUTIM(3,NSUBS) C C CPUTIM R*4 ARRAY TO ACCUMULATE ENTRY COUNTS C AND EXECUTION TIMES C C COMMON /TIMCM1/ NAMES C REAL*8 NAMES(NSUBS) C C * NAMES R*8 ARRAY TO CONTAIN SUBROUTINE NAMES IN A8 FORMAT C (INITIALIZE WITH DATA STATEMENT) C C COMMON /TIMCM2/ ISTAK C INTEGER ISTAK(NSTAK) C C ISTAK I*2 ARRAY FOR SUBROUTINE NESTING C C COMMON /TIMCM3/ TSTAK C REAL TSTAK(NSTAK) C C TSTAK R*4 ARRAY FOR SUBROUTINE NESTING C C C C NOTE: A MESSAGE IS PRINTED AFTER THE TABLE OF VALUES IF EITHER C THE SUBROUTINE NESTING DEPTH WAS EXCEEDED, OR THE CALL C TO TIMEOF WAS MADE FROM OTHER THAN THE MAIN PROGRAM C (E.G., FROM A USER EXIT ROUTINE). CPU TIMES UP TO THE C POINT OF STACK OVERFLOW ARE CORRECTLY DISPLAYED. ALL C CPU TIME AFTER THE OVERFLOW IS ACCUMULATED FOR THE ROUTINE C THAT CAUSED THE OVERFLOW, UNTIL THE CONDITION IS RESOLVED C (I.E., TIMRET IS CALLED FOR EVERY ROUTINE PAST THE OVERFLOW). C C- SUBROUTINE TIMEON REAL CPUTIM(3,1), TSTAK(1) REAL*8 NAMES(1) INTEGER ISTAK(1) C COMMON /TIMCOM/ LUN, NSUBS, NSTAK, TIME, KURNT, ITOP, IERR COMMON /TIMCM0/ CPUTIM COMMON /TIMCM1/ NAMES COMMON /TIMCM2/ ISTAK COMMON /TIMCM3/ TSTAK C C KURNT = 0 C C... INITIALIZE AND START CPU TIMER IF (NSUBS .LE. 0) RETURN IF (NSTAK .LE. 0) RETURN DO 100 J = 1,NSUBS CPUTIM(1,J) = 0.0 CPUTIM(2,J) = 0.0 100 CPUTIM(3,J) = 0.0 KURNT = 1 IERR = 0 ITOP = 0 TIME = SECNDS(0.0) CPUTIM(1,1) = 1.0 RETURN END C C STOP TIMING C SUBROUTINE TIMEOF REAL CPUTIM(3,1), TSTAK(1) REAL*8 NAMES(1) INTEGER ISTAK(1) C COMMON /TIMCOM/ LUN, NSUBS, NSTAK, TIME, KURNT, ITOP, IERR COMMON /TIMCM0/ CPUTIM COMMON /TIMCM1/ NAMES COMMON /TIMCM2/ ISTAK COMMON /TIMCM3/ TSTAK C C IF (KURNT .LE. 0) RETURN TIME1 = SECNDS(0.0) ET = TIME1 - TIME IF (ET .LT. 0.0) ET = 86400.0 + ET TIME = TIME1 CPUTIM(2,KURNT) = ET + CPUTIM(2,KURNT) IF (ITOP .GT. 0) CPUTIM(3,KURNT) = (TIME-TSTAK(ITOP)) + 1 CPUTIM(3,KURNT) IF (LUN .LE. 0) GOTO 1000 C C... PRINT STATISTICS WRITE(LUN,502) 502 FORMAT(1X// 1 3X,'----- Execution Profile (Elapsed Time in Secs) -----' 2 //26X,'Subr Only',15X,'W/Calls'/ 3 ' Name',7x,'Freq.',5X,'Avg',5X,'Elapsed Time', 4 5X,'Avg',4X,'Total'/) ISUMF = 0 SUMT = 0.0 DO 200 J = 1,NSUBS ISUMF = IFIX(CPUTIM(1,J)) + ISUMF 200 SUMT = CPUTIM(2,J) + SUMT CPUTIM(3,1) = SUMT SUMFP = 0.0 SUMTP = 0.0 DO 250 J = 1,NSUBS TP = 100.0 * CPUTIM(2,J) / SUMT SUMTP = TP + SUMTP AVGCUM = CPUTIM(1,J) AVGTIM = AVGCUM IFREQ = IFIX(AVGCUM) IF (IFREQ .EQ. 0) GOTO 240 AVGTIM = CPUTIM(2,J) / AVGCUM AVGCUM = CPUTIM(3,J) / AVGCUM 240 WRITE(LUN,503) NAMES(J), IFREQ, 1 AVGTIM, CPUTIM(2,J), TP, AVGCUM, CPUTIM(3,J) 503 FORMAT (1X, A8, 1X, I5, 3X, F8.2, F8.2,' (',F5.1,'%)', 1 F8.2, F8.2) 250 CONTINUE WRITE(LUN,504) ISUMF, SUMT, SUMTP 504 FORMAT('0',2X,'Total:',1X, I5,11X,F8.2,' (',F5.1,'%)'/) 300 IF (KURNT .NE. 1) WRITE(LUN,506) NAMES(KURNT) 506 FORMAT (/' *** TIMEOF called while executing ', A8) C IF (IERR .NE. 0) 1 WRITE(LUN,505) NAMES(IERR) 505 FORMAT (/' *** TIMER: Nesting depth exceeded in ', A8) C 1000 KURNT = 0 RETURN END C C TIMCAL -- INITIATE TIMING C SUBROUTINE TIMCAL (NSUB) REAL CPUTIM(3,1), TSTAK(1) REAL*8 NAMES(1) INTEGER ISTAK(1), TENTR(6) C COMMON /TIMCOM/ LUN, NSUBS, NSTAK, TIME, KURNT, ITOP, IERR COMMON /TIMCM0/ CPUTIM COMMON /TIMCM1/ NAMES COMMON /TIMCM2/ ISTAK COMMON /TIMCM3/ TSTAK C DATA TENTR/'0-','--','> ','En','te','r '/ C IF (KURNT .LE. 0) RETURN IF (NSUB .GT. NSUBS) RETURN IF (NSUB .LE. 1) RETURN TIME1 = SECNDS(0.0) ET = TIME1 - TIME IF (ET .LT. 0.0) ET = 86400.0 + ET TIME = TIME1 CPUTIM(2,KURNT) = ET + CPUTIM(2,KURNT) IF (ITOP .EQ. NSTAK) 1 IERR = NSUB ITOP = 1 + ITOP IF (ITOP .GT. NSTAK) RETURN ISTAK(ITOP) = KURNT TSTAK(ITOP) = TIME KURNT = NSUB ICNT = IFIX(CPUTIM(1,KURNT)) + 1 CPUTIM(1,KURNT) = FLOAT(ICNT) IF (LUN.GT.0) 1 WRITE(LUN,501) TENTR, NAMES(KURNT), ICNT 501 FORMAT (6A2,A8,' (',I5,')') RETURN END C C TIMRET -- END TIMING COUNT FOR SUBROUTINE C SUBROUTINE TIMRET (NSUB) REAL CPUTIM(3,1), TSTAK(1) REAL*8 NAMES(1) INTEGER ISTAK(1), TLEAV(6) C COMMON /TIMCOM/ LUN, NSUBS, NSTAK, TIME, KURNT, ITOP, IERR COMMON /TIMCM0/ CPUTIM COMMON /TIMCM1/ NAMES COMMON /TIMCM2/ ISTAK COMMON /TIMCM3/ TSTAK C DATA TLEAV/' -','--','> ','Le','av','e '/ C IF (KURNT .LE. 1) RETURN IF (NSUB .NE. KURNT) GOTO 100 IF (LUN.GT.0) 1 WRITE(LUN,501) TLEAV, NAMES(KURNT) 501 FORMAT (6A2,A8) TIME1 = SECNDS(0.0) ET = TIME1 - TIME IF (ET .LT. 0.0) ET = 86400.0 + ET TIME = TIME1 CPUTIM(2,KURNT) = ET + CPUTIM(2,KURNT) IF (ITOP .GT. NSTAK) GOTO 100 IF (ITOP .LE. 0) RETURN CPUTIM(3,KURNT) = (TIME-TSTAK(ITOP)) + CPUTIM(3,KURNT) KURNT = ISTAK(ITOP) 100 ITOP = ITOP - 1 RETURN END C C SUBROUTINE TIMCL(NSUB) COMMON /TIMCOM/ LUN, NSUBS, NSTAK, TIME, KURNT, ITOP, IERR ISVLUN=LUN LUN=0 CALL TIMCAL(NSUB) LUN=ISVLUN RETURN END C SUBROUTINE TIMRT(NSUB) COMMON /TIMCOM/ LUN, NSUBS, NSTAK, TIME, KURNT, ITOP, IERR ISVLUN=LUN LUN=0 CALL TIMRET(NSUB) LUN=ISVLUN RETURN END