SUBROUTINE FTN_CREATE_STATS_SUB IMPLICIT NONE ! ! Program to process the input drawing data file ! and generate 2 statistics files. ! ! Flow: ! Read every record from the drawing file. ! For each record update both statistics arrays. ! Upon completion of input file, close it. ! Calculate over-all stats values updating arrays. ! Write new statistics index files. ! INCLUDE 'MEGA_TEXT_LIB (FTN_MEGA_RECS)' INCLUDE '(LIB$ROUTINES)' C;;;;; C Constants we need C;;;;; INTEGER*1 K_DRAW_CHAN, K_ELM_COUNT PARAMETER( K_DRAW_CHAN=6, K_ELM_COUNT=52) INTEGER*1 K_DSTAT_CHAN, K_MSTAT_CHAN PARAMETER( K_DSTAT_CHAN=7, K_MSTAT_CHAN=8) CHARACTER*12 DRAWING_DATA CHARACTER*13 DRAWING_STATS CHARACTER*10 MEGA_STATS PARAMETER( DRAWING_DATA='MY_MEGA_FILE') PARAMETER( DRAWING_STATS='DRAWING_STATS') PARAMETER( MEGA_STATS='MEGA_STATS') C;;;;; C Local variables C;;;;; RECORD /DRAWING_RECORD/DRAW_REC RECORD /ZILLIONARE_STATS_RECORD/DSTAT RECORD /ZILLIONARE_STATS_RECORD/MSTAT RECORD /ZILLIONARE_STATS_RECORD/D_STATS(K_ELM_COUNT) RECORD /ZILLIONARE_STATS_RECORD/M_STATS(K_ELM_COUNT) INTEGER*4 L_D_STAT, L_M_STAT, L_DRAW_STAT INTEGER*4 L_DRAW_NO LOGICAL EOF_LG INTEGER*1 B_X INTEGER*4 L_MISSED C;;;;;;;;;; C Main Logic C;;;;;;;;;; 100 CALL FTN_FILL_IN_LOGICALS 210 OPEN (UNIT=K_DRAW_CHAN, 1 FILE=DRAWING_DATA, 2 STATUS='OLD', 3 ORGANIZATION='INDEXED', 4 ACCESS='KEYED', 5 RECORDTYPE='FIXED', 6 FORM='UNFORMATTED', 7 RECL=K_DRAWING_RECORD_SIZE/4, 8 CARRIAGECONTROL='FORTRAN', 9 KEY=(1:8:CHARACTER), 1 DISP='KEEP', 2 IOSTAT=L_DRAW_STAT, 3 SHARED, 4 ERR=999) 220 OPEN (UNIT=K_DSTAT_CHAN, 1 FILE=DRAWING_STATS, 2 STATUS='NEW', 3 ORGANIZATION='INDEXED', 4 ACCESS='KEYED', 5 RECORDTYPE='FIXED', 6 FORM='UNFORMATTED', 7 RECL=K_ZILLIONARE_STATS_RECORD_SIZE/4, 8 CARRIAGECONTROL='FORTRAN', 9 KEY=(1:4:INTEGER), 1 DISP='KEEP', 2 IOSTAT=L_D_STAT, 3 SHARED, 4 ERR=996) 230 OPEN (UNIT=K_MSTAT_CHAN, 1 FILE=MEGA_STATS, 2 STATUS='NEW', 3 ORGANIZATION='INDEXED', 4 ACCESS='KEYED', 5 RECORDTYPE='FIXED', 6 FORM='UNFORMATTED', 7 RECL=K_ZILLIONARE_STATS_RECORD_SIZE/4, 8 CARRIAGECONTROL='FORTRAN', 9 KEY=(1:4:INTEGER), 1 DISP='KEEP', 2 IOSTAT=L_DRAW_STAT, 3 SHARED, 4 ERR=998) C;;;;; C Now read until end of file filling in our arrays C;;;;; 300 EOF_LG = .FALSE. L_DRAW_NO = 0 READ (K_DRAW_CHAN, KEYGE=' ', KEYID=0, 1 IOSTAT=L_DRAW_STAT) DRAW_REC IF (L_DRAW_STAT .GT. 0) THEN PRINT *, 'Error ', L_DRAW_STAT, ' reading first record' EOF_LG = .TRUE. END IF DO 399 1 WHILE (EOF_LG .EQ. .FALSE. .AND. L_DRAW_STAT .EQ. 0) L_DRAW_NO = L_DRAW_NO + 1 IF (MOD(L_DRAW_NO, 100) .EQ. 0) THEN PRINT *, 'Processed ', L_DRAW_NO, ' records' END IF CALL FTN_UPDATE_DRAW_STATS( DRAW_REC, D_STATS,L_DRAW_NO) CALL FTN_UPDATE_MEGA_STATS( DRAW_REC, M_STATS,L_DRAW_NO) READ (K_DRAW_CHAN, IOSTAT=L_DRAW_STAT) DRAW_REC 399 CONTINUE PRINT *, 'Total record: ', L_DRAW_NO C;;;;; C Now generate the stats C;;;;; 400 DO 499 B_X=1,K_ELM_COUNT,1 ! ! Drawing stats ! D_STATS( B_X).PCT_HITS = REAL(D_STATS( B_X).HIT_COUNT) 1 / REAL( L_DRAW_NO) L_MISSED = L_DRAW_NO - D_STATS(B_X).HIT_COUNT D_STATS( B_X).AVE_BTWN = REAL(L_MISSED) 1 / REAL(D_STATS(B_X).HIT_COUNT) D_STATS( B_X).SINCE_LAST = L_DRAW_NO - 1 D_STATS( B_X).LAST_DRAW_NO ! ! Mega stats ! M_STATS( B_X).PCT_HITS = REAL(M_STATS( B_X).HIT_COUNT) 1 / REAL( L_DRAW_NO) L_MISSED = L_DRAW_NO - M_STATS(B_X).HIT_COUNT IF (M_STATS(B_X).HIT_COUNT .GT. 0) THEN M_STATS( B_X).AVE_BTWN = REAL(L_MISSED) 1 / REAL(M_STATS(B_X).HIT_COUNT) END IF IF ( M_STATS( B_X).LAST_DRAW_NO .GT. 0) THEN M_STATS( B_X).SINCE_LAST = L_DRAW_NO - 1 M_STATS( B_X).LAST_DRAW_NO END IF 499 CONTINUE C;;;;; C Now Write the stats C;;;;; 500 DO 599 B_X=1,K_ELM_COUNT,1 D_STATS( B_X).ELM_NO = B_X DSTAT = D_STATS( B_X) WRITE (K_DSTAT_CHAN,ERR=996,IOSTAT=L_D_STAT), DSTAT M_STATS( B_X).ELM_NO = B_X MSTAT = M_STATS( B_X) WRITE (K_MSTAT_CHAN,ERR=998,IOSTAT=L_M_STAT), MSTAT 599 CONTINUE GO TO 1000 996 PRINT *, 'Error ',L_D_STAT, ' writing drawing stats' GO TO 1000 998 PRINT *, 'Error ',L_M_STAT, ' writing mega stats' GO TO 1000 999 PRINT *, 'Error ', L_DRAW_STAT, ' opening drawing' PRINT *, 'Error ', L_D_STAT, ' opening dstats' PRINT *, 'Error ', L_M_STAT, ' opening mstats' 1000 CLOSE( K_DRAW_CHAN) CLOSE( K_DSTAT_CHAN) CLOSE( K_MSTAT_CHAN) RETURN END C;;;;;;;;;; C Subroutine to update the drawing stats C;;;;;;;;;; SUBROUTINE FTN_UPDATE_DRAW_STATS( DRAW_REC, D_STATS,L_D_NO) IMPLICIT NONE INCLUDE 'MEGA_TEXT_LIB (FTN_MEGA_RECS)' INTEGER*1 K_ELM_COUNT PARAMETER( K_ELM_COUNT=52) RECORD /DRAWING_RECORD/DRAW_REC RECORD /ZILLIONARE_STATS_RECORD/D_STATS(K_ELM_COUNT) INTEGER*1 B_SUB INTEGER*4 L_X, L_D_NO,L_NO(5) L_NO(1) = DRAW_REC.NO_1 L_NO(2) = DRAW_REC.NO_2 L_NO(3) = DRAW_REC.NO_3 L_NO(4) = DRAW_REC.NO_4 L_NO(5) = DRAW_REC.NO_5 DO 1200 B_SUB=1,5, 1 L_X = L_D_NO - D_STATS(L_NO(B_SUB)).LAST_DRAW_NO IF (L_X .EQ. 1) THEN D_STATS( L_NO(B_SUB)).CURR_SEQ = 1 D_STATS( L_NO(B_SUB)).CURR_SEQ + 1 IF (D_STATS(L_NO(B_SUB)).CURR_SEQ .GT. 1 D_STATS(L_NO(B_SUB)).LONGEST_SEQ) THEN D_STATS(L_NO(B_SUB)).LONGEST_SEQ = 1 D_STATS(L_NO(B_SUB)).CURR_SEQ END IF ELSE D_STATS( L_NO(B_SUB)).CURR_SEQ = 0 IF (L_X .GT. D_STATS( L_NO(B_SUB)).MAX_BTWN) THEN D_STATS(L_NO(B_SUB)).MAX_BTWN = L_X END IF END IF D_STATS( L_NO(B_SUB)).HIT_COUNT = 1 D_STATS(L_NO(B_SUB)).HIT_COUNT + 1 D_STATS( L_NO(B_SUB)).LAST_DRAW_NO = L_D_NO D_STATS( L_NO(B_SUB)).SINCE_LAST = L_X 1200 CONTINUE RETURN END C;;;;;;;;;; C Subroutine to update the MEGA stats C;;;;;;;;;; SUBROUTINE FTN_UPDATE_MEGA_STATS( DRAW_REC, M_STATS,L_D_NO) IMPLICIT NONE INCLUDE 'MEGA_TEXT_LIB (FTN_MEGA_RECS)' INTEGER*1 K_ELM_COUNT PARAMETER( K_ELM_COUNT=52) RECORD /DRAWING_RECORD/DRAW_REC RECORD /ZILLIONARE_STATS_RECORD/M_STATS(K_ELM_COUNT) INTEGER*4 L_SUB INTEGER*4 L_X, L_D_NO L_SUB = DRAW_REC.MEGA_NO L_X = L_D_NO - M_STATS(L_SUB).LAST_DRAW_NO IF (L_X .EQ. 1) THEN M_STATS( L_SUB).CURR_SEQ = M_STATS( L_SUB).CURR_SEQ + 1 IF (M_STATS(L_SUB).CURR_SEQ .GT. 1 M_STATS(L_SUB).LONGEST_SEQ) THEN M_STATS(L_SUB).LONGEST_SEQ = 1 M_STATS(L_SUB).CURR_SEQ END IF ELSE M_STATS( L_SUB).CURR_SEQ = 0 IF (L_X .GT. M_STATS( L_SUB).MAX_BTWN) THEN M_STATS(L_SUB).MAX_BTWN = L_X END IF END IF M_STATS( L_SUB).HIT_COUNT = M_STATS(L_SUB).HIT_COUNT + 1 M_STATS( L_SUB).LAST_DRAW_NO = L_D_NO M_STATS( L_SUB).SINCE_LAST = L_X 2200 CONTINUE RETURN END