C****************************************************************************** SUBROUTINE AK$PCT_TIM(PRC_START,PRC_END,CON_TIM,PCT_TIM) C****************************************************************************** C AKPCTTIM.FOR C C written by: M. Serrer C date: March 1984 C INCLUDE 'AK.INC/NOLIST' C INTEGER*4 PRC_START(2),PRC_END(2) INTEGER*4 TIM_DIF(2),CON_TIM,WEEKDAY REAL*4 PCT_TIM C D1=24*60 C C_Initialize percentage to be 100% Prime time C PCT_TIM=1.0 C C_Use QUADMATH to determine CONNECT time in seconds C CALL SUBQUAD(PRC_END,PRC_START,TIM_DIF) CALL EDIV(TIM_DIF,10000000,CON_TIM) C C_Find number of minutes of connect time C C1=CON_TIM/60 C IF (C1.GT.D1) THEN !_Process ran longer than 24 hours PCT_TIM=0.0 !_so give discount rate 0% PRIME time RETURN END IF C C_If weekend, ie. WEEKDAY=((1=SUNDAY) , (7=SATURDAY)) , give discount C CALL FIND_DOW(PRC_START,WEEKDAY) C IF (WEEKDAY.EQ.1.OR.WEEKDAY.EQ.7) THEN PCT_TIM=0 RETURN END IF C C_Get PROCESS START and END time in MINUTES from midnight C ISTAT=SYS$ASCTIM(,START_STR,PRC_START,%VAL(1)) DECODE(11,'(I2,X,I2)',START_STR) S1HOUR,S1MIN S1=S1HOUR*60+S1MIN C ISTAT=SYS$ASCTIM(,END_STR,PRC_END,%VAL(1)) DECODE(11,'(I2,X,I2)',END_STR) E1HOUR,E1MIN E1=E1HOUR*60+E1MIN C C------------------------------------------------------------------------------ C_Decide percentage PRIME time used C------------------------------------------------------------------------------ C IF (S1.LT.P1) THEN !_(process start) before (prime start) C IF (E1.LT.P1) THEN !_(process end) before (prime start) PCT_TIM=0.0 !_0% PRIME time RETURN ELSE IF (E1.LT.P2) THEN !_(process end) before (prime end) PCT_TIM=(E1-P1)/(E1-S1) !_(process end-prime start)/total time RETURN ELSE PCT_TIM=(P2-P1)/(E1-S1) !_(prime duration/process duration) RETURN END IF C------------------------------------------------------------------------------ ELSE IF (S1.GE.P2) THEN !_(process start) after (prime end) C PCT_TIM=0.0 !_0% PRIME time RETURN C------------------------------------------------------------------------------ ELSE IF (S1.GE.P1) THEN !_(process start) after (prime start) C IF (E1.LT.P2) THEN !_(process end) before (prime end) PCT_TIM=1.0 !_100% PRIME time RETURN ELSE PCT_TIM=(P2-S1)/(E1-S1) !_(prime end-process start)/total time RETURN END IF C------------------------------------------------------------------------------ ELSE TYPE*,'*** WARNING, Problem finding % PRIME time, set to 0%' PCT_TIM=0.0 END IF C RETURN END C C****************************************************************************** SUBROUTINE FIND_DOW(QUAD_TIME,WEEK_DAY) C****************************************************************************** C C This routine returns the day of the week as an integer C between (1,7) given the date as a QUAD WORD in the VMS C system format. C C 1=SUNDAY,2=MONDAY,....7=SATURDAY C C------------------------------------------------------------------------------ C IMPLICIT INTEGER (A-Z) INTEGER*4 QUAD_TIME(2),WEEK_DAY,SLEN,IDATE,IYEAR REAL*4 MTH,DATE,YEAR,Z1,Z2,Z3,Z4,Z5,Z6,Z7,Z8,Z9 CHARACTER*3 MONTHS(12) CHARACTER*24 DATE_STR C DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN', & 'JUL','AUG','SEP','OCT','NOV','DEC'/ C ISTAT=SYS$ASCTIM(S_LEN,DATE_STR,QUAD_TIME,%VAL(0)) DECODE(S_LEN,'(I2,5X,I4)',DATE_STR) IDATE,IYEAR DATE=IDATE YEAR=IYEAR C DO I=1,12 IF (DATE_STR(4:6).EQ.MONTHS(I)) GOTO 10 END DO 10 MTH=I C Z1=INT(0.6+(1.0/MTH)) Z2=YEAR-Z1 Z3=MTH+12.0*Z1 Z4=Z2/100.0 Z5=INT(Z4/4.0) Z6=INT(Z4) Z7=INT((5.0*Z2)/4.0) Z8=INT(13.0*(Z3+1.0)/5.0) Z9=Z8+Z7-Z6+Z5+DATE-1.0 C WEEK_DAY=Z9-(7.0*INT(Z9/7.0))+1.0 C RETURN END