CAINDMDSKIO -- PERFORMS DISK I/O USING SINGLE ARRAY 00010001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CTITLE DSKIO -- PERFORMS DISK I/O USING SINGLE ARRAY 00011001 CA 00020000 CA AUTHOR BILL BLACK 00030000 CA DESIGNER BOB DECKER 00040000 CA LANGUAGE FORTRAN 00050000 CA SYSTEM IBM AND CRAY 00060000 C WRITTEN WHEN 00070000 C REVISED 09-17-84 TRA FOR PRODUCTION SPARC. 00080000 C REVISIONS ARE TO ACCOMODATE SUMMED 00090000 C CEPSTRAL VECTORS. 00100000 C REVISED 01-21-85 TRA IMPROVE EFFICIENCY. 00110000 C REVISED 07-07-86 JMP. DUAL IBM/CRAY VERSION 00120000 C REVISED 03-04-88 ESN. REDUCE NUMBER OF RECORDS TO 00130000 C COMPENSATE FOR LARGER RECORD SIZE. 00140000 C REVISED 11-13-89 RDK. FOR CRAY CFT77 COMPATIBILITY. 00140100 CA 00150000 CA 00160000 CA CALLING SEQUENCE: 00170000 CA 00180000 CA CALL DSKIO (KPWKS3, MXREC, MNEM, LEN, RA) 00190000 CA 00200000 CA IN KPWKS3 I4 DISK ADDRESS OF THIRD WORKFILE 00210000 CA IN MXREC I4 MAX. NUMBER OF RECORDS ON WORKFILE. 00220000 CA IN MNEM A1 MNEMONIC TO APPEND ON WORKFILE NAME. 00230000 CA IN LEN I4 DESIRED LENGTH 00240000 CA OUT RA R4 I/O BUFFER. 00250000 CA 00260000 CA 00270000 CA THIS SUBROUTINE IS USED TO TAKE AN ARRAY (PASSED THRU AN ARGUMENT 00280000 CA OF THE CALLING PROGRAM) AND PUT STORED OUT ON DISK. ITS RETRIEVED 00290000 CA WHEN NEEDED THRU VARIOUS ENTRY POINTS. 00300000 CA 00310000 CA 00320000 CA SUBROUTINES CALLED: FORC CORE ARMVE ARSET 00330000 CA FOISSD FOWSSD FOCSD FOIDSD 00340000 CA 00350000 CA 00360000 CA MULTI-ENTRY ROUTINE: DSKSTR -- STORES DAT IN RA UNTIL FULL 00370000 CA DSKOPN -- CLOSES SEQUENTIAL, OPENS DIRECT 00380000 CA DSKUPD -- UPDATES INPUT DATA 00390000 CA DSKMVE -- FINAL STORING OF THE DATA 00400000 CA 00410000 CAEND 00420001 C 00430000 C 00440000 SUBROUTINE DSKIO (KPWKS3, MXREC, MNEM, LEN, RA) 00450000 IMPLICIT INTEGER (A-Z) 00460000 INTEGER KPWKS3(2) 00470000 CHARACTER*1 MNEM 00480000 CHARACTER*8 DDNAME 00490000 REAL A (1) 00500000 REAL RA (1) 00510000 REAL RECSOL 00520000 REAL SRCSOL 00530000 REAL CDPSOL 00540000 REAL NMOSOL 00550000 REAL NEWP 00560000 REAL OLDP 00570000 REAL ERR 00580000 REAL TERR 00590000 REAL TAMP 00600000 REAL RATIO 00610000 REAL RATIO1 00620000 REAL THOLD 00630000 C 00630100 SAVE VCTINR 00630200 SAVE MXBUF 00630300 C 00640000 COMMON /SYSTEM/ SYSTEM, SYBYPW, SYLOCF, JAPNMS 00650000 C 00660000 C INITIALIZATION 00670000 C 00680000 LBUF = LEN * 6 00690000 C 00700000 IF (S1CPCH(SYSTEM, 1, 'CRAY', 1, 4) .EQ. 0) THEN 00710000 MXBUF = 4000 00720000 ELSE 00730000 MXBUF = 8000 00740000 ENDIF 00750000 C 00760000 BLKLN = MXBUF / LBUF 00770000 NEWLN = LBUF * BLKLN * 4 00780000 NEWREC = (MXREC-1)/BLKLN + 1 00790000 C 00800000 CALL UPAWRK(NEWREC, NEWLN, MNEM, KPWKS3(1), KPWKS3(2), DDNAME, 00810000 * ERRWRK, ERIN) 00820000 IF (ERRWRK .NE. 1) THEN 00830000 WRITE (6, 5) MNEM, ERRWRK, ERIN 00840000 5 FORMAT(' *** ERROR *** DSKIO: COULD NOT ALLOCATE FILE ', 00850000 * A1,'. ERRWRK, ERIN = ',2(I6,1X)) 00860000 CALL XDUMPX 00870000 ENDIF 00880000 C 00890000 C OPEN SEQUENTIAL 00900000 C 00910000 CALL FOISSD (KPWKS3, NEWLN, 0) 00920000 CALL ARSET (RA, LBUF, 0.0) 00930000 RETURN 00940000 C 00950000 C****************************************************************** 00960000 C ENTRY STORES DATA IN RA UNTIL FULL , THEN WRITES FILE TO DISK 00970000 C****************************************************************** 00980000 C 00990000 CTITLE DSKSTR -- STORES DATA IN RA UNTIL FULL, THEN OUT TO DISK 01000000 CA 01010000 CA AUTHOR BILL BLACK 01020000 CA DESIGNER BOB DECKER 01030000 CA LANGUAGE FORTRAN H 01040000 CA SYSTEM S/370 01050000 C WRITTEN WHEN 01060000 C REVISED 01070000 CA 01080000 CA 01090000 CA CALLING SEQUENCE: 01100000 CA 01110000 CA ENTRY DSKSTR (A, LEN, RA, IPTR, NUM, SEQDA, KPWKS3, IPR) 01120000 CA 01130000 CA IN A R4 INPUT ARRAY 01140000 CA IN LEN I4 THE LENGTH OF THE BUFFER WORDS 01150000 CA IN RA R4 RESERVED MEMORY 01160000 CA IN IPTR I4 THE BLOCK NUMBER TO BE WORKED WITH 01170000 CA IN/OUT NUM I4 THE NUMBER OF RECORDS WRITTEN TO DISK 01180000 CA IN SEQDA I4 RECORD WRITTEN OR READ 01190000 CA IN KPWKS3 I4 DISK ADDRESS OF THE THIRD SEQUENTIAL 01200000 CA WORKFILE 01210000 CA IN IPR I4 PRINTER UNIT NUMBER 01220000 CA 01230000 CA 01240000 CA THIS ENTRY STORES DATA FROM A INTO RA UNTIL THE PROPER NUMBER OF 01250000 CA BLOCK-LENGTHS HAVE BEEN STORED, THEN RA IS PLACED OUT ON DISK. 01260000 CAEND 01270001 C 01280000 C 01290000 C 01300000 ENTRY DSKSTR (A, LEN, RA, IPTR, NUM, SEQDA, KPWKS3, IPR) 01310000 LBUF = LEN * 6 01320000 BLKLN = MXBUF / LBUF 01330000 C 01340000 INDX = (IPTR-1) * LBUF + 1 01350000 CALL ARMVE (A, RA(INDX), LBUF) 01360000 IF (IPTR.NE.BLKLN) GO TO 10 01370000 C 01380000 C WRITES BUFFER OUT TO DISC WHEN ITS FULL, IPTR IS RESET 01390000 C 01400000 CALL FOWSSD (KPWKS3, SEQDA, RA) 01410000 C 01420000 NUM = NUM + 1 01430000 IPTR = 0 01440000 10 IPTR = IPTR + 1 01450000 RETURN 01460000 C 01470000 C****************************************************************** 01480000 C ENTRY CLOSES FILE FOR SEQUENTIAL AND OPENS FOR DIRECT ACCESS 01490000 C****************************************************************** 01500000 C 01510000 CTITLE DSKOPN -- CLOSES FILE FOR SEQUENTIAL , OPENS FOR DIRECT ACCESS 01520000 CA 01530000 CA AUTHOR BILL BLACK 01540000 CA DESIGNER BOB DECKER 01550000 CA LANGUAGE FORTRAN H 01560000 CA SYSTEM S/370 01570000 C WRITTEN WHEN 01580000 C REVISED 01590000 CA 01600000 CA 01610000 CA CALLING SEQUENCE: 01620000 CA 01630000 CA ENTRY DSKOPN (KPWKS3, KPWKD3, LEN) 01640000 CA 01650000 CA IN KPWKS3 I4 DISK ADDRESS OF THIRD SEQUENTIAL FILE 01660000 CA IN KPWKD3 I4 DISK ADDRESS OF THIRD DIRECT ACCESS FILE 01670000 CA IN LEN I4 LENGTH OF FILES. 01680000 CA 01690000 CA 01700000 CA THIS ENTRY CLOSES FILE FOR SEQUENTIAL AND OPENS FILE FOR DIRECT 01710000 CA ACCESS. 01720000 CAEND 01730001 C 01740000 C 01750000 ENTRY DSKOPN (KPWKS3, KPWKD3, LEN) 01760000 LBUF = LEN * 6 01770000 BLKLN = MXBUF / LBUF 01780000 NEWLN = LBUF * BLKLN * 4 01790000 C 01800000 CALL FOCSD (KPWKS3) 01810000 CALL FOIDSD(KPWKD3, NEWLN) 01820000 RETURN 01830000 C 01840000 C******************************************************************* 01850000 C ENTRY FOR UPDATE 01860000 C******************************************************************* 01870000 C 01880000 CTITLE DSKUPD -- UPDATES THE BLOCKS WITH DATA FROM CALLING PROGRAM 01890000 CA 01900000 CA AUTHOR BILL BLACK 01910000 CA DESIGNER BOB DECKER 01920000 CA LANGUAGE FORTRAN H 01930000 CA SYSTEM S/370 01940000 C WRITTEN WHEN 01950000 C REVISED 01960000 C********************************************************************** 01970000 CA 01980000 CA CALLING SEQUENCE: 01990000 CA 02000000 CA CALL DSKUPD (RECSOL, SRCSOL, CDPSOL, NMOSOL, IPTR, RA, LEN, 02010000 CA NPTR, OLDP, NEWP, SEQDA, KPWKD3, IPR, LAST) 02020000 CA 02030000 CA IN RECCOL R4 VALUE TO BE STORED IN THE RECEIVER VECTOR 02040000 CA IN SRCSOL R4 VALUE TO BE STORED IN THE SOURCE VECTOR 02050000 CA IN CDPSOL R4 VALUE TO BE STORED IN THE CDP VECTOR 02060000 CA IN NMOSOL I4 VALUE TO BE STORED IN THE NMO VECTOR 02070000 CA IN IPTR I4 BLOCK NUMBER TO BE WORKED ON 02080000 CA IN LEN I4 VECTOR LENGTH 02090000 CA IN RA R4 RESERVED AREA (MEMORY) 02100000 CA IN NPTR I4 ADDRESS OF WORD WITHIN BLOCK FOR NEW VALUES 02110000 CA TO BE STORED 02120000 CA OUT OLDP I4 OLD VALUE IN ATTRIBUTE VECTOR 02130000 CA OUT NEWP R4 VALUE RETRIEVED OUT OF ATTRIBUTE VECTOR AND 02140000 CA RETURNED TO CALLING PROGRAM 02150000 CA IN SEQDA I4 RECORD NUMBER 02160000 CA IN KPWKD3 I4 DISK ADDRESS OF THIRD DIRECT ACCESS FILE 02170000 CA IN IPR I4 PRINTER UNIT NUMBER 02180000 CA IN LAST I4 LAST TRACE FLAG 02190000 CA 02200000 CA 02210000 CA THIS ENTRY UPDATES THE BLOCKS WITH VALUES BEING PASSED IN FROM 02220000 CA CALLING PROGRAM. 02230000 CA 02240000 CAEND 02250001 C 02260000 C 02270000 C 02280000 ENTRY DSKUPD (RECSOL, SRCSOL, CDPSOL, NMOSOL, IPTR, LEN, RA, 02290000 * NPTR, OLDP, NEWP, SEQDA, KPWKD3, IPR, LAST) 02300000 C 02310000 LBUF = LEN * 6 02320000 BLKLN = MXBUF / LBUF 02330000 C 02340000 C READING FILE DA & STORING PROPER VALUES IN RA 02350000 C 02360000 IF (IPTR.EQ.1) 02370000 * CALL FORDSD (KPWKD3, SEQDA, RA) 02380000 C 02390000 INDEX = (IPTR-1) * LBUF 02400000 RA (2*LEN+NPTR+INDEX) = SRCSOL 02410000 RA (3*LEN+NPTR+INDEX) = RECSOL 02420000 RA (4*LEN+NPTR+INDEX) = CDPSOL 02430000 RA (5*LEN+NPTR+INDEX) = NMOSOL 02440000 OLDP = RA(LEN+NPTR + INDEX) 02450000 NEWP = RA(LEN+NPTR+1+INDEX) 02460000 IF (IPTR.NE.BLKLN .AND. LAST.EQ.0) GO TO 30 02470000 C 02480000 C WRITING FILE BACK OUT 02490000 C 02500000 SEQDAO = SEQDA - 1 02510000 CALL FOWDSD (KPWKD3, SEQDAO, RA) 02520000 IPTR = 0 02530000 30 IPTR = IPTR + 1 02540000 RETURN 02550000 C 02560000 C 02570000 C 02580000 C 02590000 C******************************************************************* 02600000 C ENTRY FOR EDITING OUT BAD TRACES 02610000 C******************************************************************* 02620000 C 02630000 CTITLE DSKEDT -- UPDATES THE BLOCKS WITH ERROR INFORMATION 02640000 CA 02650000 CA AUTHOR BILL BLACK 02660000 CA DESIGNER BOB DECKER 02670000 CA LANGUAGE FORTRAN H 02680000 CA SYSTEM S/370 02690000 C WRITTEN WHEN 02700000 C REVISED 02710000 CA 02720000 CA 02730000 CA CALLING SEQUENCE: 02740000 CA 02750000 CA CALL DSKEDT(RECSOL, SRCSOL, CDPSOL, NMOSOL, IPTR, LEN, RA, 02760000 CA VCTINC, NPTR, OLDP, NEWP, SEQDA, KPWKD3, IPR, LAST, 02770000 CA * TERR, TAMP, JC) 02780000 CA 02790000 CA IN RECCOL R4 VALUE TO BE STORED IN THE RECEIVER VECTOR 02800000 CA IN SRCSOL R4 VALUE TO BE STORED IN THE SOURCE VECTOR 02810000 CA IN CDPSOL R4 VALUE TO BE STORED IN THE CDP VECTOR 02820000 CA IN NMOSOL I4 VALUE TO BE STORED IN THE NMO VECTOR 02830000 CA IN IPTR I4 BLOCK NUMBER TO BE WORKED ON 02840000 CA IN LEN I4 VECTOR LENGTH 02850000 CA IN RA R4 RESERVED AREA (MEMORY) 02860000 CA IN VCTINC I4 VECTOR INCREMENT 02870000 CA IN NPTR I4 ADDRESS OF WORD WITHIN BLOCK FOR NEW VALUES 02880000 CA TO BE STORED 02890000 CA OUT OLDP R4 OLD VALUE IN ATTRIBUTE VECTOR 02900000 CA OUT NEWP R4 VALUE RETRIEVED OUT OF ATTRIBUTE VECTOR AND 02910000 CA RETURNED TO CALLING PROGRAM 02920000 CA IN SEQDA I4 RECORD NUMBER 02930000 CA IN KPWKD3 I4 DISK ADDRESS OF THIRD DIRECT ACCESS FILE 02940000 CA IN IPR I4 PRINTER UNIT NUMBER 02950000 CA IN LAST I4 LAST TRACE FLAG 02960000 CA IN/OUT TERR R4 TOTAL CEPSTRAL ERROR 02970000 CA IN/OUT TAMP R4 TOTAL CEPSTRAL AMPLITUDE 02980000 CA IN JC I4 FIRST CEPSTRAL TIME FLAG 02990000 CA 03000000 CA 03010000 CA 03020000 CA THIS ENTRY UPDATES THE BLOCKS WITH VALUES BEING PASSED IN FROM 03030000 CA CALLING PROGRAM. ERROR INFORMATION IS CALCULATED AND STORED 03040000 CA TO ALLOW FOR REJECTION OF BAD TRACES. 03050000 CA 03060000 CAEND 03070001 C 03080000 C 03090000 ENTRY DSKEDT (RECSOL, SRCSOL, CDPSOL, NMOSOL, IPTR, LEN, RA, 03100000 * VCTINC, NPTR, OLDP, NEWP, SEQDA, KPWKD3, IPR, LAST, 03110000 * TERR, TAMP, JC) 03120000 C 03130000 LBUF = LEN * 6 03140000 BLKLN = MXBUF / LBUF 03150000 C 03160000 C READING FILE DA & STORING PROPER VALUES IN RA 03170000 C 03180000 IF (IPTR.EQ.1) 03190000 * CALL FORDSD (KPWKD3, SEQDA, RA) 03200000 C 03210000 C 03220000 INDEX = (IPTR-1) * LBUF 03230000 ERR = RA(NPTR+INDEX+LEN) - SRCSOL - RECSOL - CDPSOL - NMOSOL 03240000 TERR = TERR + ABS(ERR) 03250000 TAMP = TAMP + ABS(RA(NPTR+INDEX+LEN)) 03260000 INDX = 5*LEN + INDEX + 1 03270000 C 03280000 IF(JC.EQ.1) CALL ARSET(RA(INDX), LEN, 0.0) 03290000 IF(JC.NE.1) RA(INDX) = RA(INDX) + ABS(ERR) 03300000 C 03310000 OLDP = RA(NPTR + LEN + INDEX) 03320000 NEWP = RA(NPTR + LEN + VCTINC+INDEX) 03330000 C 03340000 C 03350000 C WRITE(IPR, 9000) 03360000 C WRITE(IPR, 9010) INDEX, ERR, TERR, JC, OLDP, NEWP, INDX, RATIO 03370000 C9000 FORMAT (T10,'INDEX',T20,'ERR',T30,'TERR',T40,'JC',T50,'OLDP', 03380000 C * T60,'NEWP' ,T70,'INDX') 03390000 C9010 FORMAT (T10,I5, T20,E10.4, T30,E10.4, T40,I2, T50,E10.4, 03400000 C * T60,E10.4, T70,I10) 03410000 C 03420000 C 03430000 IF (IPTR.NE.BLKLN .AND. LAST.EQ.0) GO TO 40 03440000 C 03450000 C WRITING FILE BACK OUT 03460000 C 03470000 SEQDAO = SEQDA - 1 03480000 CALL FOWDSD (KPWKD3, SEQDAO, RA) 03490000 IPTR = 0 03500000 40 IPTR = IPTR + 1 03510000 VCTINR = VCTINC 03510100 C 03510200 RETURN 03520000 C 03540000 C 03550000 C 03560000 C******************************************************************* 03570000 C ENTRY FOR REJECTING BAD TRACES 03580000 C******************************************************************* 03590000 C 03600000 CTITLE DSKREJ -- UPDATES THE BLOCKS WITH REJECTION INFORMATION 03610000 CA 03620000 CA AUTHOR BILL BLACK 03630000 CA DESIGNER BOB DECKER 03640000 CA LANGUAGE FORTRAN H 03650000 CA SYSTEM S/370 03660000 C WRITTEN WHEN 03670000 C REVISED 03680000 CA 03690000 CA 03700000 CA CALLING SEQUENCE: 03710000 CA 03720000 CA CALL DSKREJ(IPTR, LEN, RA, 03730000 CA * SEQDA, KPWKD3, IPR, LAST, 03740000 CA * A, NEWP, TRCNT, THOLD, TOTALT, KPBUGF) 03750000 CA 03760000 CA IN IPTR I4 BLOCK NUMBER TO BE WORKED ON 03770000 CA IN LEN I4 VECTOR LENGTH 03780000 CA IN RA R4 RESERVED AREA (MEMORY) 03790000 CA IN VCTINC I4 VECTOR INCREMENT 03800000 CA IN NPTR I4 ADDRESS OF WORD WITHIN BLOCK FOR NEW VALUES 03810000 CA TO BE STORED 03820000 CA RETURNED TO CALLING PROGRAM 03830000 CA IN SEQDA I4 RECORD NUMBER 03840000 CA IN KPWKD3 I4 DISK ADDRESS OF THIRD DIRECT ACCESS FILE 03850000 CA IN IPR I4 PRINTER UNIT NUMBER 03860000 CA IN LAST I4 LAST TRACE FLAG 03870000 CA IN A R4 ARRAYS OF ERROR VALUES FOR REJECTION 03880000 CA OUT NEWP R4 NEW VALUE FOR NEXT VECTOR TO BE PROCESSED 03890000 CA IN THOLD R4 THRESHOLD FOR REJECTION 03900000 CA IN TRCNT I4 TRACE COUNTER 03910000 CA IN TOTALT I4 TOTAL NUMBER OF TRACES 03920000 CA IN KPBUGF I4 DEBUG PRINT FOR EDITING 03930000 CA 03940000 CA 03950000 CA THIS ENTRY UPDATES THE BLOCKS WITH VALUES BEING PASSED IN FROM 03960000 CA CALLING PROGRAM. REJECTION INFORMATION IS STORED 03970000 CA TO ALLOW FOR REJECTION OF BAD TRACES. 03980000 CA 03990000 CAEND 04000001 C 04010000 C 04020000 ENTRY DSKREJ (IPTR, LEN, RA, 04030000 * SEQDA, KPWKD3, IPR, LAST, 04040000 * A, NEWP, TRCNT, THOLD, TOTALT, KPBUGF) 04050000 C 04060000 LBUF = LEN * 6 04070000 BLKLN = MXBUF / LBUF 04080000 C 04090000 C READING FILE DA & STORING PROPER VALUES IN RA 04100000 C 04110000 IF (IPTR.EQ.1) 04120000 * CALL FORDSD (KPWKD3, SEQDA, RA) 04130000 C 04140000 INDEX = (IPTR-1) * LBUF 04150000 C 04160000 C DETERMINE WHETHER TO REJECT A TRACE 04170000 C 04180000 IF(KPBUGF.LT.2) GO TO 24 04190000 RATIO = A(TRCNT)/A(TOTALT+TRCNT) 04200000 RATIO1= A(TOTALT+TRCNT)/A(TRCNT) 04210000 C 04220000 C 04230000 24 IF(A(TRCNT) .LE. THOLD*A(TOTALT+TRCNT)) GO TO 27 04240000 C 04250000 C 04260000 C 04270000 DO 25 I=1,LEN 04280000 25 RA(INDEX + I + LEN ) = 2.0E6 04290000 C 04300000 IF(KPBUGF.GE.2) 04310000 *WRITE(IPR,9999) TRCNT, A(TRCNT), A(TOTALT+TRCNT), RATIO, RATIO1 04320000 C 04330000 9999 FORMAT(' TRACE REJECTED ', I5, 2E12.4,' RATIO ===>',E12.4, 04340000 * 5X,' RATIO1===>',E12.4) 04350000 GO TO 39 04360000 C 04370000 27 IF(KPBUGF.EQ.3) 04380000 *WRITE(IPR,9998) TRCNT, A(TRCNT), A(TOTALT+TRCNT), RATIO, RATIO1, 04390000 * THOLD 04400000 9998 FORMAT(' NOT REJECTED ', I5, 2E12.4,' RATIO ===>',E12.4, 04410000 * 5X,' RATIO1===>',E12.4, 04420000 * 5X,' THOLD ===>',E12.4) 04430000 39 NEWP = RA(INDEX+LEN+1) 04440000 IF (IPTR.NE.BLKLN .AND. LAST.EQ.0) GO TO 50 04450000 C 04460000 C WRITING FILE BACK OUT 04470000 C 04480000 SEQDAO = SEQDA - 1 04490000 CALL FOWDSD (KPWKD3, SEQDAO, RA) 04500000 IPTR = 0 04510000 50 IPTR = IPTR + 1 04520000 RETURN 04530000 C 04540000 C 04550000 C 04560000 C 04570000 C******************************************************************* 04580000 C ENTRY FOR SUMMING ERRORS FOR EACH TRACE 04590000 C******************************************************************* 04600000 C 04610000 CTITLE DSKSUM -- UPDATES THE BLOCKS WITH ERROR INFORMATION 04620000 CA 04630000 CA AUTHOR BILL BLACK 04640000 CA DESIGNER BOB DECKER 04650000 CA LANGUAGE FORTRAN H 04660000 CA SYSTEM S/370 04670000 C WRITTEN WHEN 04680000 C REVISED 04690000 CA 04700000 CA 04710000 CA CALLING SEQUENCE: 04720000 CA 04730000 CA CALL DSKSUM( IPTR, LEN, RA, 04740000 CA * SEQDA, KPWKD3, IPR, LAST, NEWP, NUMDO) 04750000 CA 04760000 CA IN IPTR I4 BLOCK NUMBER TO BE WORKED ON 04770000 CA IN LEN I4 VECTOR LENGTH 04780000 CA IN RA R4 RESERVED AREA (MEMORY) 04790000 CA IN VCTINC I4 VECTOR INCREMENT 04800000 CA IN NPTR I4 ADDRESS OF WORD WITHIN BLOCK FOR NEW VALUES 04810000 CA TO BE STORED 04820000 CA RETURNED TO CALLING PROGRAM 04830000 CA IN SEQDA I4 RECORD NUMBER 04840000 CA IN KPWKD3 I4 DISK ADDRESS OF THIRD DIRECT ACCESS FILE 04850000 CA IN IPR I4 PRINTER UNIT NUMBER 04860000 CA IN LAST I4 LAST TRACE FLAG 04870000 CA IN NUMDO I4 NUMBER OF VECTORS TO PROCESS 04880000 CA 04890000 CA 04900000 CA THIS ENTRY UPDATES THE BLOCKS WITH VALUES BEING PASSED IN FROM 04910000 CA CALLING PROGRAM. ERROR INFORMATION IS ACCUMULATED FOR ERROR 04920000 CA ANLAYSIS FOR REJECTION OF BAD TRACES. 04930000 CAEND 04940001 C 04950000 C 04960000 C 04970000 ENTRY DSKSUM ( IPTR, LEN, RA, 04980000 * SEQDA, KPWKD3, IPR, LAST, NEWP, NUMDO) 04990000 C 05000000 LBUF = LEN * 6 05010000 BLKLN = MXBUF / LBUF 05020000 C 05030000 C READING FILE DA & SUMMING ERRORS 05040000 C 05050000 IF (IPTR.EQ.1) 05060000 * CALL FORDSD (KPWKD3, SEQDA, RA) 05070000 C 05080000 INDEX = (IPTR-1) * LBUF 05090000 NEWP = RA(5*LEN + INDEX + 1)/(FLOAT((NUMDO-1)/VCTINR)) 05100000 C 05110000 IF (IPTR.NE.BLKLN .AND. LAST.EQ.0) GO TO 60 05120000 C 05130000 C 05140000 IPTR = 0 05150000 60 IPTR = IPTR + 1 05160000 RETURN 05170000 C 05180000 C 05190000 C 05200000 C 05210000 C********************************************************************* 05220000 C ENTRY FOR DATA TRANSFER FROM RA TO A 05230000 C********************************************************************* 05240000 C 05250000 CTITLE DSKMVE -- MOVES DATA FROM RA TO A 05260000 CA 05270000 CA AUTHOR BILL BLACK 05280000 CA DESIGNER BOB DECKER 05290000 CA LANGUAGE FORTRAN H 05300000 CA SYSTEM S/370 05310000 C WRITTEN WHEN 05320000 C REVISED 05330000 CA 05340000 CA 05350000 CA CALLING SEQUENCE: 05360000 CA 05370000 CA ENTRY DSKMVE (A, LEN, RA, IPTR, SEQDA, KPWKD3, IPR) 05380000 CA 05390000 CA OUT A R4 RETURNING DATA ARRAY 05400000 CA IN LEN I4 LENGTH OF A IN WORDS 05410000 CA IN RA R4 RESERVED MEMORY 05420000 CA IN IPTR I4 BLOCK NUMBER BEING STORED 05430000 CA IN KPWKD3 I4 DISK ADDRESS OF THIRD WORKFILE 05440000 CA IN SEQDA R4 RECORD NUMBER 05450000 CA IN IPR I4 PRINTER UNIT NUMBER 05460000 CA 05470000 CA 05480000 CA 05490000 CA MOVES DATA FROM RA TO AND RETURNS THE DATA IN A TO CALLING PROGRAM05500000 CAEND 05510001 C 05520000 C 05530000 ENTRY DSKMVE (A, LEN, RA, IPTR, SEQDA, KPWKD3, IPR) 05540000 C 05550000 LBUF = LEN * 6 05560000 BLKLN = MXBUF / LBUF 05570000 C 05580000 C ============================================================== 05590000 C 05600000 C IF (IPTR.EQ.1) WRITE (IPR,7000) SEQDA, IPTR, BLKLN 05610000 C IF (IPTR.NE.1) WRITE (IPR,7010) SEQDA, IPTR, BLKLN 05620000 C 05630000 C7000 FORMAT(' ====> RECORD READ ',I5,10X,'=====> IPTR = ',I5,10X 05640000 C * ,'====> BLKLN =', I5) 05650000 C7010 FORMAT(' NOT READ -- RECORD ',I5,10X,'=====> IPTR = ', I5,10X 05660000 C * ,'====> BLKLN =', I5) 05670000 C 05680000 C ================================================================== 05690000 C 05700000 IF (IPTR.EQ.1) 05710000 * CALL FORDSD (KPWKD3, SEQDA, RA) 05720000 C 05730000 INDEX = (IPTR-1) * LBUF + 1 05740000 CALL ARMVE (RA(INDEX), A, LBUF) 05750000 IF (IPTR.EQ.BLKLN) IPTR = 0 05760000 IPTR = IPTR + 1 05770000 RETURN 05780000 C 05790000 C********************************************************************* 05800000 C ENTRY FOR WRITING OUT ANY LEFTOVER DATA 05810000 C********************************************************************* 05820000 C 05830000 CTITLE DSKWRT -- THE FINAL WRITE TO DISK OF LEFTOVER DATA 05840000 CA 05850000 CA AUTHOR BILL BLACK 05860000 CA DESIGNER BOB DECKER 05870000 CA LANGUAGE FORTRAN H 05880000 CA SYSTEM S/370 05890000 C WRITTEN WHEN 05900000 C REVISED 05910000 CA 05920000 CA 05930000 CA CALLING SEQUENCE: 05940000 CA 05950000 CA ENTRY DSKWRT (RA, NUM, SEQDA, KPWKS3) 05960000 CA 05970000 CA IN RA R4 RESERVED PACKING AREA 05980000 CA IN NUM I4 COUNTER OF THE AMOUNT OF TIMES RECORDS HAVE 05990000 CA BEEN WRITTEN TO DISK 06000000 CA IN SEQDA I4 THE NUMBER OF THE RECORD BEING WRITTEN TO 06010000 CA DISK 06020000 CA IN KPWKS3 I4 THE DISK ADDRESS OF THE DATA BEING WRITTEN 06030000 CA 06040000 CA 06050000 CA THIS ENTRY POINT WRITES THE LEFTOVER DATA , IF ANY, TO DISK. 06060000 CA 06070000 CA 06080000 CA SUBROUTINES CALLED: FOWSSD 06090000 CAEND 06100001 C 06110000 C 06120000 ENTRY DSKWRT (RA, NUM, SEQDA, KPWKS3) 06130000 CALL FOWSSD (KPWKS3, SEQDA, RA) 06140000 NUM = NUM + 1 06150000 RETURN 06160000 END 06170000