CAINDMFOTRCE -- SUMMARY OF TRACE INPUT/OUTPUT OPERATIONS 00010001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CTITLE FOTRCE -- SUMMARY OF TRACE INPUT/OUTPUT OPERATIONS 00020001 C AUTHOR STU NELAN 00030001 C DESIGNERS STU NELAN 00040001 C LANGUAGE FORTRAN 00050001 C SYSTEM IBM AND CRAY 00060001 C WRITTEN 11-06-89 00070001 C REVISED 09-16-93 ESN. IF WT3D, AND IF IBM, AND IF AN ODD 00080001 C NUMBER OF SAMPLES ARE BEING WRITTEN, 00090001 C THEN WRITE OUT ONE EXTRA WORD OF '0' 00100001 C IN CASE THE DATA MAY BE READ ON THE CRAY.00110001 C 00120001 C 00130001 C CALL FOIRTR (DCBAD, BLKSIZ, STATUS) 00140001 C INPUT DCBAD = ADDRESS OF A QSAM DCB. I4 00150001 C BLKSIZ = MAXIMUM BLOCK SIZE IN WORDS. I4 00160001 C OUTPUT STATUS = STATUS CODE. 1 = OK. I4 00170001 C 2 = OPEN FAILED. 00180001 C 9 = NO DD-CARD OR 00190001 C BLANK DDNAME. 00200001 C INITIALIZE TO READ TRACES. STORES BLOCK SIZE, BUFFER 00210001 C LENGTH, EODAD ADDRESS, SYNAD ADDRESS, AND EXIT LIST 00220001 C ADDRESS IN THE DCB, THEN OPENS THE DCB FOR INPUT. 00230001 C IMPORTANT: BE SURE TO CALL FOCRTR TO CLOSE THE DATA SET. 00240001 C CALL FORTR (DCBAD, DATA, LEN, STATUS, BLKCOUNT) 00250001 C INPUT DCBAD = ADDRESS OF QSAM DCB OPENED BY FOIRTR. I4 00260001 C OUTPUT DATA = ARRAY OF LENGTH LEN. ANY 00270001 C LEN = LENGTH IN WORDS OF RECORD READ. I4 00280001 C STATUS = STATUS CODE. I4 00290001 C 1 = OK. 00300001 C 2 = FILE NOT OPEN. 00310001 C 3 = READ ERROR. 00320001 C 4 = VOLUME SWITCH. 00330001 C 5 = CONCATENATION. 00340001 C 6 = VOLUME SWITCH + READ ERROR. 00350001 C 7 = CONCATENATION + READ ERROR. 00360001 C 8 = END OF FILE. 00370001 C 9 = NO DD-CARD OR BLANK DDNAME. 00380001 C BLKCOUNT = BLOCK COUNT FROM TRAILER LABEL AND 2I4 00390001 C BLOCK COUNT AS READ (FROM DCBBLKCT). 00400001 C READ TRACE DATA. READS THE RECORD INTO DATA, THEN GETS 00410001 C THE RECORD LENGTH FROM THE LOGICAL RECORD LENGTH FIELD 00420001 C (LRECL) OF THE DCB AND RETURNS IT IN LEN. 00430001 C EODAD AND SYNAD ARE IN THIS SECTION. 00440001 C IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 00450001 C CALL FOCRTR TO CLOSE THE DATA SET. 00460001 C 00470001 C CALL FODRTR (DCBAD, DSNAD, VOLAD) 00480001 C INPUT DCBAD = ADDRESS OF QSAM DATA CONTROL BLOCK. I4 00490001 C OUTPUT DSNAD = CURRENT DATA SET NAME. C44 00500001 C OUTPUT VOLAD = CURRENT VOLUME SERIAL NUMBER. C6 00510001 C 00520001 C CALL FOCRTR (DCBAD, STATUS) 00530001 C INPUT DCBAD = ADDRESS OF A QSAM DCB. I4 00540001 C OUTPUT STATUS = STATUS CODE. 1 = OK. I4 00550001 C 2 = CLOSE FAILED. 00560001 C CLOSE INPUT TRACE DCB. CLOSE AND REWIND FILE AND FREE 00570001 C BUFFERS SO THEY CAN BE REALLOCATED. 00580001 C IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 00590001 C CALL FOCRTR TO CLOSE THE DATA SET. 00600001 C CALL FOIWTR (DCBAD, BLKSIZ, STATUS) 00610001 C INPUT DCBAD = ADDRESS OF A BSAM DCB. I4 00620001 C BLKSIZ = MAXIMUM BLOCK SIZE IN WORDS. I4 00630001 C OUTPUT STATUS = STATUS CODE. 1 = OK. I4 00640001 C 2 = OPEN FAILED. 00650001 C 9 = NO DD-CARD OR 00660001 C BLANK DDNAME. 00670001 C INITIALIZE TO OUTPUT TRACE DATA. STORES THE MAXIMUM BLOCK 00680001 C SIZE AND RECORD LENGTH IN THE DCB, THEN OPENS THE DCB FOR 00690001 C OUTPUT. 00700001 C IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 00710001 C CALL FOCWTR TO CLOSE THE DATA SET. 00720001 C 00730001 C CALL FOVWTR (DCBAD, VOLAD) 00740001 C INPUT DCBAD = ADDRESS OF QSAM DATA CONTROL BLOCK. I4 00750001 C OUTPUT VOLAD = CURRENT VOLUME SERIAL NUMBER. C6 00760001 C 00770001 C CALL FOWTR (DCBAD, DATA, LEN, STATUS) 00780001 C INPUT DCBAD = ADDRESS OF A BSAM DCB OPENED BY FOIWTR. I4 00790001 C LEN = LENGTH (WORDS) OF RECORD TO BE WRITTEN. I4 00800001 C DATA = ARRAY CONTAINING THE RECORD. ANY 00810001 C OUTPUT STATUS = STATUS CODE. 1 = OK. 00820001 C 2 = FILE NOT OPEN. 00830001 C 3 = WRITE ERROR. 00840001 C 4 = VOLUME SWITCH. 00850001 C 6 = VOLUME SWITCH + ERROR. 00860001 C WRITE TRACE DATA. RECORD LENGTH IS SMALLER OF LEN AND 00870001 C BLOCK SIZE. 00880001 C IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 00890001 C CALL FOCWTR TO CLOSE THE DATA SET. 00900001 C 00910001 C CALL FOCWTR (DCBAD, STATUS) 00920001 C INPUT DCBAD = ADDRESS OF A BSAM DCB. I4 00930001 C OUTPUT STATUS = STATUS CODE. 1 = OK. I4 00940001 C 2 = CLOSE FAILED. 00950001 C CLOSE OUTPUT TRACE DCB. CLOSE AND REWIND FILE. 00960001 C IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 00970001 C CALL FOCWTR TO CLOSE THE DATA SET. 00980001 C 00990001 C SUMMARY OF STATUS CODES. 01000001 C 01010001 C STATUS FOIRTR FORTR FOCRTR FOIWTR FOWTR FOCWTR 01020001 C 1 OK OK OK OK OK OK 01030001 C 2 FAILED CLOSED FAILED FAILED CLOSED FAILED 01040001 C 3 ERROR ERROR 01050001 C 4 EOV EOV 01060001 C 5 CONCAT 4 + 3 01070001 C 6 4 + 3 01080001 C 7 5 + 3 01090001 C 8 EOF 01100001 C 9 NO DD NO DD NO DD 01110001 C END 01120001 CTITLE FOIRTR -- OPEN TRACE INPUT DATA SET 01130001 CA AUTHORS DEBORAH REED, FRANCIS COLLINS 01140001 CA DESIGNERS DEBORAH REED, FRANCIS COLLINS 01150001 CA LANGUAGE S/370 ASSEMBLER 01160001 CA WRITTEN 3- 5-75, 4-23-76 01170001 CA 01180001 CA 01190001 CA CALL FOIRTR (DCBAD, BLKSIZ, STATUS) 01200001 CA INPUT DCBAD = ADDRESS OF A QSAM DCB. I4 01210001 CA BLKSIZ = MAXIMUM BLOCK SIZE IN WORDS. I4 01220001 CA OUTPUT STATUS = STATUS CODE. 1 = OK. I4 01230001 CA 2 = OPEN FAILED. 01240001 CA 9 = NO DD-CARD OR 01250001 CA BLANK DDNAME. 01260001 CA 01270001 CA 01280001 CA INITIALIZE TO READ TRACES. STORES BLOCK SIZE, BUFFER 01290001 CA LENGTH, EODAD ADDRESS, SYNAD ADDRESS, AND EXIT LIST 01300001 CA ADDRESS IN THE DCB, THEN OPENS THE DCB FOR INPUT. 01310001 CA IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 01320001 CA CALL FOCRTR TO CLOSE THE DATA SET. 01330001 CA 01340001 CA REQUIRED PARAMETERS FOR QSAM DATA CONTROL BLOCK: 01350001 CA 01360001 CA DDNAME, DSORG=PS, MACRF=(GM), RECFM=UT 01370001 CAEND 01380001 CTITLE FORTR -- READ TRACE 01390001 CA AUTHORS DEBORAH REED, FRANCIS COLLINS 01400001 CA DESIGNERS DEBORAH REED, FRANCIS COLLINS 01410001 CA LANGUAGE S/370 ASSEMBLER 01420001 CA WRITTEN 3- 5-75, 4-23-76 01430001 CA 01440001 CA 01450001 CA CALL FORTR (DCBAD, DATA, LEN, STATUS, BLKCOUNT) 01460001 CA INPUT DCBAD = ADDRESS OF QSAM DCB OPENED BY FOIRTR. I4 01470001 CA OUTPUT DATA = ARRAY OF LENGTH LEN. ANY 01480001 CA LEN = LENGTH IN WORDS OF RECORD READ. I4 01490001 CA STATUS = STATUS CODE. I4 01500001 CA 1 = OK. 01510001 CA 2 = FILE NOT OPEN. 01520001 CA 3 = READ ERROR. 01530001 CA 4 = VOLUME SWITCH. 01540001 CA 5 = CONCATENATION. 01550001 CA 6 = VOLUME SWITCH + READ ERROR. 01560001 CA 7 = CONCATENATION + READ ERROR. 01570001 CA 8 = END OF FILE. 01580001 CA 9 = NO DD-CARD OR BLANK DDNAME. 01590001 CA BLKCOUNT = BLOCK COUNT FROM TRAILER LABEL AND 2I4 01600001 CA BLOCK COUNT AS READ (FROM DCBBLKCT). 01610001 CA 01620001 CA 01630001 CA READ TRACE DATA. READS THE RECORD INTO DATA, THEN GETS 01640001 CA THE RECORD LENGTH FROM THE LOGICAL RECORD LENGTH FIELD 01650001 CA (LRECL) OF THE DCB AND RETURNS IT IN LEN. 01660001 CA EODAD AND SYNAD ARE IN THIS SECTION. 01670001 CA IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 01680001 CA CALL FOCRTR TO CLOSE THE DATA SET. 01690001 CAEND 01700001 CTITLE FODRTR -- GET CURRENT NAME OF INPUT TRACE DATA SET 01710001 CA AUTHOR/DESIGNER FRANCIS COLLINS 01720001 CA LANGUAGE S/370 ASSEMBLER 01730001 CA WRITTEN 6-14-76 01740001 CA 01750001 CA 01760001 CA CALL FODRTR (DCBAD, DSNAD, VOLAD) 01770001 CA INPUT DCBAD = ADDRESS OF BSAM DATA CONTROL BLOCK. I4 01780001 CA OUTPUT DSNAD = CURRENT DATA SET NAME OF A44 01790001 CA INPUT TRACE DATA SET 01800001 CA OPENED BY FOIRTR. 01810001 CA OUTPUT VOLAD = CURRENT VOLUME SERIAL NUMBER. A6 01820001 CAEND 01830001 CTITLE FOCRTR -- CLOSE TRACE INPUT DATA SET 01840001 CA AUTHORS DEBORAH REED, FRANCIS COLLINS 01850001 CA DESIGNERS DEBORAH REED, FRANCIS COLLINS 01860001 CA LANGUAGE S/370 ASSEMBLER 01870001 CA WRITTEN 3- 5-75, 4-23-76 01880001 CA 01890001 CA 01900001 CA CALL FOCRTR (DCBAD, STATUS) 01910001 CA INPUT DCBAD = ADDRESS OF A QSAM DCB. I4 01920001 CA OUTPUT STATUS = STATUS CODE. 1 = OK. I4 01930001 CA 2 = CLOSE FAILED. 01940001 CA 01950001 CA 01960001 CA CLOSE INPUT TRACE DCB. 01970001 CA IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 01980001 CA CALL FOCRTR TO CLOSE THE DATA SET. 01990001 CAEND 02000001 CTITLE FOIWTR -- OPEN TRACE OUTPUT DATA SET 02010001 CA AUTHORS DEBORAH REED, FRANCIS COLLINS 02020001 CA DESIGNERS DEBORAH REED, FRANCIS COLLINS 02030001 CA LANGUAGE S/370 ASSEMBLER 02040001 CA WRITTEN 3- 5-75, 4-23-76 02050001 CA 02060001 CA 02070001 CA CALL FOIWTR (DCBAD, BLKSIZ, STATUS) 02080001 CA INPUT DCBAD = ADDRESS OF A QSAM DCB. I4 02090001 CA BLKSIZ = MAXIMUM BLOCK SIZE IN WORDS. I4 02100001 CA OUTPUT STATUS = STATUS CODE. 1 = OK. I4 02110001 CA 2 = OPEN FAILED. 02120001 CA 9 = NO DD-CARD OR 02130001 CA BLANK DDNAME. 02140001 CA 02150001 CA 02160001 CA INITIALIZE TO OUTPUT TRACE DATA. STORES THE MAXIMUM BLOCK 02170001 CA SIZE AND RECORD LENGTH IN THE DCB, THEN OPENS THE DCB FOR 02180001 CA OUTPUT. 02190001 CA IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 02200001 CA CALL FOCWTR TO CLOSE THE DATA SET. 02210001 CA 02220001 CA REQUIRED PARAMETERS FOR QSAM DATA CONTROL BLOCK: 02230001 CA 02240001 CA DDNAME, DSORG=PS, MACRF=(PM), RECFM=UT 02250001 CAEND 02260001 CTITLE FOVWTR -- GET CURRENT VOLUME NO. OF OUTPUT TRACE DATA SET 02270001 CA AUTHOR/DESIGNER FRANCIS COLLINS 02280001 CA LANGUAGE S/370 ASSEMBLER 02290001 CA WRITTEN 12-17-80 02300001 CA 02310001 CA 02320001 CA CALL FOVWTR (DCBAD, VOLAD) 02330001 CA INPUT DCBAD = ADDRESS OF QSAM DATA CONTROL BLOCK. I4 02340001 CA OUTPUT VOLAD = CURRENT VOLUME SERIAL NUMBER OF A6 02350001 CA OUTPUT TRACE DATA SET 02360001 CA OPENED BY FOIWTR. 02370001 CAEND 02380001 CTITLE FOWTR -- WRITE TRACE 02390001 CA AUTHORS DEBORAH REED, FRANCIS COLLINS 02400001 CA DESIGNERS DEBORAH REED, FRANCIS COLLINS 02410001 CA LANGUAGE S/370 ASSEMBLER 02420001 CA WRITTEN 3- 5-75, 4-23-76 02430001 CA 02440001 CA 02450001 CA CALL FOWTR (DCBAD, DATA, LEN, STATUS) 02460001 CA INPUT DCBAD = ADDRESS OF A QSAM DCB OPENED BY FOIWTR. I4 02470001 CA LEN = LENGTH (WORDS) OF RECORD TO BE WRITTEN. I4 02480001 CA DATA = ARRAY CONTAINING THE RECORD. ANY 02490001 CA OUTPUT STATUS = STATUS CODE. I4 02500001 CA 1 = OK. 02510001 CA 2 = FILE NOT OPEN. 02520001 CA 3 = WRITE ERROR. 02530001 CA 4 = VOLUME SWITCH. 02540001 CA 6 = VOLUME SWITCH AND WRITE ERROR. 02550001 CA 02560001 CA 02570001 CA WRITE TRACE DATA. RECORD LENGTH IS SMALLER OF LEN AND 02580001 CA BLOCK SIZE. 02590001 CA IMPORTANT NOTE: WHEN PROCESSING IS FINISHED, BE SURE TO 02600001 CA CALL FOCWTR TO CLOSE THE DATA SET. 02610001 CAEND 02620001 CTITLE FOCWTR -- CLOSE TRACE OUTPUT DATA SET 02630001 CA AUTHORS DEBORAH REED, FRANCIS COLLINS 02640001 CA DESIGNERS DEBORAH REED, FRANCIS COLLINS 02650001 CA LANGUAGE S/370 ASSEMBLER 02660001 CA WRITTEN 3- 5-75, 4-23-76 02670001 CA 02680001 CA 02690001 CA CALL FOCWTR (DCBAD, STATUS) 02700001 CA INPUT DCBAD = ADDRESS OF A QSAM DCB. I4 02710001 CA OUTPUT STATUS = STATUS CODE. 1 = OK. I4 02720001 CA 2 = CLOSE FAILED. 02730001 CA 02740001 CA 02750001 CA CLOSE OUTPUT TRACE DCB. CLOSE AND REWIND FILE. 02760001 CAEND 02770001 C********************************************************************** 02780001 C 02790001 C EXAMPLE QSAM INPUT DCB: 02800001 C 02810001 C IN DCB DDNAME=DBG001,DSORG=PS,MACRF=(GM),RECFM=UT 02820001 C 02830001 C 02840001 C EXAMPLE QSAM OUTPUT DCB: 02850001 C 02860001 C OUT DCB DDNAME=DBG002,DSORG=PS,MACRF=(PM),RECFM=UT 02870001 C 02880001 C********************************************************************** 02890001 SUBROUTINE FOTRCE 02900001 C 02910001 IMPLICIT INTEGER (A-Z) 02920001 C 02930001 PARAMETER (MAXDCB=500) 02940001 C 02950001 COMMON /P/ STARTP ( 2) , M00000( 102) 02960001 COMMON /P/ KPNA 02970001 C 02980001 INTEGER DATA (1) 02990001 INTEGER BLKCNT (2) 03000001 INTEGER BLKLEN (MAXDCB) 03010001 INTEGER DCBSAV (MAXDCB) 03020001 INTEGER DINDEX (MAXDCB) 03030001 INTEGER MAXREC (MAXDCB) 03040001 INTEGER NUMREC (MAXDCB) 03050001 INTEGER RECLEN (MAXDCB) 03060001 C 03070001 CHARACTER*44 DSNAD 03080001 CHARACTER*6 VOLAD 03090001 C 03100001 COMMON COM (1) 03110001 C 03120001 COMMON / SYSTEM / SYSTEM, SYBYPW 03130001 C 03140001 DATA LENHDR / 2 / 03150001 DATA MAXBYT / 32760 / 03160001 DATA NUMDCB / 0 / 03170001 C DATA PACK / 'PACK' / 03180001 DATA PACK /-675167278/ 03190001 C 03200001 CALL FATRCE 03210001 C 03220001 GO TO 8000 03230001 C 03240001 C ================== 03250001 C FOIRTR ENTRY POINT 03260001 C ================== 03270001 C 03280001 ENTRY FOIRTR (DCBAD, BLKSIZ, STATUS) 03290001 C 03300001 MAXBLK = MAXBYT / SYBYPW 03310001 CALL FAIRTR (DCBAD, MAXBLK, STATUS) 03320001 LENHDR = 8 / SYBYPW 03330001 C 03340001 C INITIALIZE SAVED VARIABLES 03350001 C 03360001 NUMDCB = NUMDCB + 1 03370001 IF (NUMDCB .GT. MAXDCB) CALL XDUMPX 03380001 DCBSAV(NUMDCB) = DCBAD 03390001 C 03400001 BLKLEN(NUMDCB) = LENHDR 03410001 C 03420001 LENI = MAXBLK 03430001 CALL GETMN2 (COM, LENI, I, LENO) 03440001 IF (LENI .NE. LENO) CALL XDUMPX 03450001 DINDEX(NUMDCB) = I + 1 03460001 C 03470001 MAXREC(NUMDCB) = BLKSIZ 03480001 C 03490001 NUMREC(NUMDCB) = 0 03500001 C 03510001 RECLEN(NUMDCB) = 0 03520001 C 03530001 GO TO 8000 03540001 C 03550001 C ================= 03560001 C FORTR ENTRY POINT 03570001 C ================= 03580001 C 03590001 ENTRY FORTR (DCBAD, DATA, LENGTH, STATUS, BLKCNT) 03600001 C 03610001 C FIND THIS DCB 03620001 C 03630001 DO 200 I = 1, NUMDCB 03640001 NDXDCB = I 03650001 IF (DCBSAV(I) .EQ. DCBAD) GO TO 210 03660001 200 CONTINUE 03670001 CALL XDUMPX 03680001 210 CONTINUE 03690001 C 03700001 C RETRIEVE INFORMATION FOR THIS DCB 03710001 C 03720001 NLEFT = NUMREC(NDXDCB) 03730001 ILOC = DINDEX(NDXDCB) 03740001 LENHDR = 8 / SYBYPW 03750001 C 03760001 C READ RECORD IF NECESSARY 03770001 C 03780001 STATUS = 1 03790001 IF (NLEFT .EQ. 0) THEN 03800001 CALL FARTR (DCBAD, COM(ILOC), LENI, STATUS, BLKCNT) 03810001 IF (STATUS .LT. 1) GO TO 8000 03820001 IF (STATUS .EQ. 2) GO TO 8000 03830001 IF (STATUS .EQ. 3) GO TO 8000 03840001 IF (STATUS .EQ. 6) GO TO 8000 03850001 IF (STATUS .EQ. 7) GO TO 8000 03860001 IF (STATUS .EQ. 8) GO TO 8000 03870001 IF (STATUS .GE. 9) GO TO 8000 03880001 ISW = -1 03890001 CALL S1MVCH (COM(ILOC),1,ISW,SYBYPW-3,4) 03900001 IF (ISW .EQ. PACK) THEN 03910001 NLEFT = 0 03920001 CALL S1MVCH (COM(ILOC),5,NLEFT,SYBYPW-3,4) 03930001 IF (NLEFT .LE. 0) CALL XDUMPX 03940001 NUMREC(NDXDCB) = NLEFT 03950001 BLKLEN(NDXDCB) = LENHDR 03960001 RECLEN(NDXDCB) = (LENI-LENHDR) / NLEFT 03970001 ELSE 03980001 LENGTH = LENI 03990001 IF (LENGTH .GT. MAXREC(NDXDCB)) LENGTH = MAXREC(NDXDCB) 04000001 CALL ARMVE (COM(ILOC), DATA, LENGTH) 04010001 GO TO 8000 04020001 ENDIF 04030001 ENDIF 04040001 C 04050001 IF (NLEFT .GT. 0) THEN 04060001 NUMREC(NDXDCB) = NLEFT - 1 04070001 LENGTH = RECLEN(NDXDCB) 04080001 IPTR = ILOC + BLKLEN(NDXDCB) 04090001 BLKLEN(NDXDCB) = BLKLEN(NDXDCB) + LENGTH 04100001 IF (LENGTH .GT. MAXREC(NDXDCB)) LENGTH = MAXREC(NDXDCB) 04110001 CALL ARMVE (COM(IPTR), DATA, LENGTH) 04120001 ENDIF 04130001 C 04140001 GO TO 8000 04150001 C 04160001 C ================== 04170001 C FOCRTR ENTRY POINT 04180001 C ================== 04190001 C 04200001 ENTRY FOCRTR (DCBAD, STATUS) 04210001 C 04220001 C FIND THIS DCB 04230001 C 04240001 DO 300 I = 1, NUMDCB 04250001 NDXDCB = I 04260001 IF (DCBSAV(I) .EQ. DCBAD) GO TO 310 04270001 300 CONTINUE 04280001 GO TO 320 04290001 310 CONTINUE 04300001 C 04310001 C RETRIEVE INFORMATION FOR THIS DCB 04320001 C 04330001 ILOC = DINDEX(NDXDCB) 04340001 MAXBLK = MAXBYT / SYBYPW 04350001 C 04360001 C FREE MEMORY 04370001 C 04380001 IF (ILOC .NE. 0) THEN 04390001 CALL FREMN2 (COM(ILOC), MAXBLK) 04400001 ENDIF 04410001 DINDEX(NDXDCB) = 0 04420001 DCBSAV(NDXDCB) = 0 04430001 C 04440001 320 CALL FACRTR (DCBAD, STATUS) 04450001 C 04460001 GO TO 8000 04470001 C 04480001 C ================== 04490001 C FODRTR ENTRY POINT 04500001 C ================== 04510001 C 04520001 ENTRY FODRTR (DCBAD, DSNAD, VOLAD) 04530001 C 04540001 CALL FADRTR (DCBAD, DSNAD, VOLAD) 04550001 C 04560001 GO TO 8000 04570001 C 04580001 C ================== 04590001 C FOIWTR ENTRY POINT 04600001 C ================== 04610001 C 04620001 ENTRY FOIWTR (DCBAD, BLKSIZ, STATUS) 04630001 C 04640001 C BLOCKING ONLY ALLOWED FOR WT3D PROCESS 04650001 C 04660001 IF (S1CPCH(KPNA,1,'WT3D',1,4) .NE. 0) THEN 04670001 CALL FAIWTR (DCBAD, BLKSIZ, STATUS) 04680001 ELSE 04690001 C 04700001 C INITIALIZE SAVED VARIABLES 04710001 C 04720001 NUMDCB = NUMDCB + 1 04730001 IF (NUMDCB .GT. MAXDCB) CALL XDUMPX 04740001 MAXBLK = MAXBYT / SYBYPW 04750001 CALL FAIWTR (DCBAD, MAXBLK, STATUS) 04760001 LENHDR = 8 / SYBYPW 04770001 DCBSAV(NUMDCB) = DCBAD 04780001 C 04790001 BLKLEN(NUMDCB) = LENHDR 04800001 C 04810001 LENI = MAXBLK 04820001 CALL GETMN2 (COM, LENI, I, LENO) 04830001 IF (LENI .NE. LENO) CALL XDUMPX 04840001 DINDEX(NUMDCB) = I + 1 04850001 CALL S1MVCH (PACK,SYBYPW-3,COM(I+1),1,4) 04860001 C 04870001 NUMREC(NUMDCB) = 0 04880001 C 04890001 RECLEN(NUMDCB) = 0 04900001 ENDIF 04910001 C 04920001 GO TO 8000 04930001 C 04940001 C ================== 04950001 C FOVWTR ENTRY POINT 04960001 C ================== 04970001 C 04980001 ENTRY FOVWTR (DCBAD, VOLAD) 04990001 C 05000001 CALL FAVWTR (DCBAD, VOLAD) 05010001 C 05020001 GO TO 8000 05030001 C 05040001 C ================= 05050001 C FOWTR ENTRY POINT 05060001 C ================= 05070001 C 05080001 ENTRY FOWTR (DCBAD, DATA, LENGTH, STATUS) 05090001 C 05100001 C BLOCKING ONLY ALLOWED FOR WT3D PROCESS 05110001 C 05120001 IF (S1CPCH(KPNA,1,'WT3D',1,4) .NE. 0) THEN 05130001 CALL FAWTR (DCBAD, DATA, LENGTH, STATUS) 05140001 ELSE 05150001 C 05160001 C FIND THIS DCB 05170001 C 05180001 DO 700 I = 1, NUMDCB 05190001 NDXDCB = I 05200001 IF (DCBSAV(I) .EQ. DCBAD) GO TO 710 05210001 700 CONTINUE 05220001 CALL XDUMPX 05230001 710 CONTINUE 05240001 C 05250001 C RETRIEVE INFORMATION FOR THIS DCB 05260001 C 05270001 ILOC = DINDEX(NDXDCB) 05280001 MAXBLK = MAXBYT / SYBYPW 05290001 LENHDR = 8 / SYBYPW 05300001 C 05310001 C DETERMINE WHETHER CONSOLIDATION IS TO BE DONE 05320001 C 05330001 LENGIN = LENGTH 05340001 CONSOL = 1 05350001 IF (LENGIN .EQ. 400/SYBYPW) CONSOL = 0 05360001 IF (LENGIN .EQ. 3200/SYBYPW) CONSOL = 0 05370001 IF (CONSOL .EQ. 1) THEN 05380001 C IF IBM AND ODD NUMBER OF SAMPLES, WRITE ONE 05390001 C EXTRA WORD IN CASE THIS DATASET IS READ ON 05400001 C THE CRAY. 05410001 IF (SYBYPW .EQ. 4) THEN 05420001 IF ((LENGIN/2)*2 .NE. LENGIN) LENGIN = LENGIN + 1 05430001 ENDIF 05440001 C 05450001 NREC = (MAXBLK-LENHDR) / LENGIN 05460001 IF (NREC .LT. 2) THEN 05470001 CONSOL = 0 05480001 LENGIN = LENGTH 05490001 ENDIF 05500001 IF (RECLEN(NDXDCB) .EQ. 0) RECLEN(NDXDCB) = LENGIN 05510001 ENDIF 05520001 C 05530001 C DOES PREVIOUS I/O NEED TO BE ISSUED? 05540001 C 05550001 STATUS = 1 05560001 IF (CONSOL .EQ. 0 .OR. 05570001 * (BLKLEN(NDXDCB)+LENGIN) .GT. MAXBLK) THEN 05580001 IF (BLKLEN(NDXDCB) .GT. LENHDR) THEN 05590001 CALL S1MVCH (NUMREC(NDXDCB),SYBYPW-3,COM(ILOC),5,4) 05600001 CALL FAWTR (DCBAD, COM(ILOC), BLKLEN(NDXDCB), STATUS) 05610001 IF (STATUS .LT. 1) GO TO 8000 05620001 IF (STATUS .EQ. 2) GO TO 8000 05630001 IF (STATUS .EQ. 3) GO TO 8000 05640001 IF (STATUS .GE. 6) GO TO 8000 05650001 BLKLEN(NDXDCB) = LENHDR 05660001 NUMREC(NDXDCB) = 0 05670001 ENDIF 05680001 ENDIF 05690001 C 05700001 C ISSUE THIS I/O IF NOT CONSOLIDATED 05710001 C 05720001 IF (CONSOL .EQ. 0) THEN 05730001 CALL FAWTR (DCBAD, DATA, LENGTH, STATUS) 05740001 GO TO 8000 05750001 ENDIF 05760001 C 05770001 C COPY RECORD TO CONSOLIDATION AREA 05780001 C 05790001 IPTR = ILOC + BLKLEN(NDXDCB) 05800001 CALL ARMVE (DATA, COM(IPTR), LENGTH) 05810001 NUMREC(NDXDCB) = NUMREC(NDXDCB) + 1 05820001 IF (LENGTH .NE. LENGIN) COM(IPTR+LENGTH) = 0 05830001 BLKLEN(NDXDCB) = BLKLEN(NDXDCB) + LENGIN 05840001 ENDIF 05850001 C 05860001 GO TO 8000 05870001 C 05880001 C ================== 05890001 C FOCWTR ENTRY POINT 05900001 C ================== 05910001 C 05920001 ENTRY FOCWTR (DCBAD, STATUS) 05930001 C 05940001 C BLOCKING ONLY ALLOWED FOR WT3D PROCESS 05950001 C 05960001 IF (S1CPCH(KPNA,1,'WT3D',1,4) .NE. 0) THEN 05970001 CALL FACWTR (DCBAD, STATUS) 05980001 ELSE 05990001 C 06000001 C FIND THIS DCB 06010001 C 06020001 DO 800 I = 1, NUMDCB 06030001 NDXDCB = I 06040001 IF (DCBSAV(I) .EQ. DCBAD) GO TO 810 06050001 800 CONTINUE 06060001 GO TO 820 06070001 810 CONTINUE 06080001 C 06090001 C RETRIEVE INFORMATION FOR THIS DCB 06100001 C 06110001 ILOC = DINDEX(NDXDCB) 06120001 MAXBLK = MAXBYT / SYBYPW 06130001 LENHDR = 8 / SYBYPW 06140001 C 06150001 C WRITE RECORD IF NECESSARY 06160001 C 06170001 IF (BLKLEN(NDXDCB) .GT. LENHDR) THEN 06180001 CALL S1MVCH (NUMREC(NDXDCB),SYBYPW-3,COM(ILOC),5,4) 06190001 CALL FAWTR (DCBAD, COM(ILOC), BLKLEN(NDXDCB), STATUS) 06200001 IF (STATUS .LT. 1) GO TO 8000 06210001 IF (STATUS .EQ. 2) GO TO 8000 06220001 IF (STATUS .EQ. 3) GO TO 8000 06230001 IF (STATUS .GE. 6) GO TO 8000 06240001 BLKLEN(NDXDCB) = LENHDR 06250001 NUMREC(NDXDCB) = 0 06260001 ENDIF 06270001 C 06280001 C FREE MEMORY 06290001 C 06300001 IF (ILOC .NE. 0) THEN 06310001 CALL FREMN2 (COM(ILOC), MAXBLK) 06320001 ENDIF 06330001 DINDEX(NDXDCB) = 0 06340001 DCBSAV(NDXDCB) = 0 06350001 C 06360001 820 CALL FACWTR (DCBAD, STATUS) 06370001 ENDIF 06380001 C 06390001 GO TO 8000 06400001 C 06410001 C ============ 06420001 C FINAL RETURN 06430001 C ============ 06440001 C 06450001 8000 RETURN 06460001 C 06470001 END 06480001