SUBROUTINE W3FI66(COCBUF,COCBLK,NFLAG,NSIZE) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . . C SUBPROGRAM: W3FI66 OFFICE NOTE 29 REPORT BLOCKER C PRGMMR: KEYSER ORG: NMC22 DATE:92-06-29 C C ABSTRACT: BLOCKS REPORTS WHICH HAVE BEEN PACKED INTO NMC OFFICE C NOTE 29 CHARACTER FORMAT INTO FIXED-LENGTH RECORDS. A REPORT C CANNOT SPAN TWO RECORDS; IF THERE IS NOT ENOUGH ROOM TO FIT C THE CURRENT REPORT IN THE RECORD, THE SUBROUTINE RETURNS TO C THE CALLING PROGRAM WITHOUT ANY MOVEMENT OF DATA. C C PROGRAM HISTORY LOG: C 90-01-?? L. MARX, UNIV. OF MD -- CONVERTED CODE FROM ASSEMBLER C TO VS FORTRAN; EXPANDED ERROR RETURN CODES IN 'NFLAG' C 91-08-23 D. A. KEYSER, NMC22 -- USE SAME ARGUMENTS AS W3AI05; C STREAMLINED CODE; DOCBLOCKED AND COMMENTED; DIAG- C NOSTIC PRINT FOR ERRORS C 92-06-29 D. A. KEYSER W/NMC22 -- CONVERT TO CRAY CFT77 FORTRAN C C USAGE: CALL W3FI66(COCBUF,COCBLK,NFLAG,NSIZE) C INPUT ARGUMENT LIST: C COCBUF - CHARACTER*10 ARRAY CONTAINING A SINGLE PACKED REPORT C - IN OFFICE NOTE 29/124 FORMAT. C COCBLK - CHARACTER*10 ARRAY HOLDING A BLOCK OF PACKED REPORTS C - UP TO AND INCLUDING THE PREVIOUS ONE C NFLAG - MARKER INDICATING RELATIVE LOCATION (IN BYTES) C - OF END OF LAST REPORT IN COCBLK. EXCEPTION: C - NFLAG MUST BE SET TO ZERO PRIOR TO BLOCKING THE FIRST C - PACKED REPORT INTO A NEW BLOCK. SUBSEQUENTLY, THE C - VALUE OF NFLAG RETURNED BY THE PREVIOUS CALL TO W3FI66 C - SHOULD BE USED AS INPUT. (SEE OUTPUT ARGUMENT LIST C - BELOW.) IF NFLAG IS NEGATIVE, W3FI66 WILL RETURN C - IMMEDIATELY WITHOUT ACTION. C NSIZE - MAXIMUM NUMBER OF CHARACTERS IN COCBLK ARRAY C (SHOULD BE A MULTIPLE OF 4) C C OUTPUT ARGUMENT LIST: C COCBLK - CHARACTER*10 ARRAY HOLDING A BLOCK OF PACKED REPORTS C - UP TO AND INCLUDING THE CURRENT ONE C NFLAG - MARKER INDICATING RELATIVE LOCATION (IN BYTES) C - OF END OF CURRENT REPORT IN COCBLK. NFLAG C - WILL BE SET TO -1 IF W3FI66 CANNOT FIT THE CURRENT C - PACKED REPORT INTO THE REMAINDER OF THE BLOCK (I.E., C - THE BLOCK IS FULL). NFLAG WILL NOT CHANGE FROM ITS C - INPUT ARGUMENT VALUE IF THE STRING "END REPORT" IS C - NOT FOUND AT THE END OF THE CURRENT REPORT. (CURRENT C - PACKED REPORT HAS INVALID LENGTH AND IS NOT BLOCKED) C C OUTPUT FILES: C FT06F001 - PRINTOUT C C REMARKS: THE USER MUST SET NFLAG TO ZERO EACH TIME THE ARRAY IS C TO BE FILLED WITH PACKED REPORTS IN OFFICE NOTE 29/124 FORMAT. C W3FI66 WILL THEN INSERT THE FIRST REPORT AND FILL THE REMAINDER C OF THE OUTPUT ARRAY COCBLK WITH THE STRING 'END RECORD'. C AN ATTEMPT IS MADE TO INSERT A REPORT IN THE OUTPUT ARRAY C EACH TIME W3FI66 IS CALLED. IF THE REMAINING PORTION OF THE C OUTPUT ARRAY IS NOT LARGE ENOUGH TO HOLD THE CURRENT REPORT, C W3FI66 SETS NFLAG TO -1. THE USER SHOULD THEN OUTPUT THE C BLOCKED RECORD, SET NFLAG TO ZERO, AND CALL W3FI66 AGAIN WITH C THE SAME REPORT IN THE INPUT ARRAY. C AFTER A GIVEN REPORT IS SUCCESSFULLY BLOCKED INTO COCBLK, C W3FI66 SETS NFLAG AS A POINTER FOR THE NEXT REPORT TO BE BLOCKED. C THIS POINTER IS A RELATIVE ADDRESS AND A CHARACTER COUNT. C THE THREE CHARACTERS SPECIFYING THE LENGTH OF THE REPORT C ARE CHECKED FOR VALID CHARACTER NUMBERS AND THE VALUE IS TESTED C FOR POINTING TO THE END OF THE REPORT (STRING "END REPORT"). IF C INVALID, THE REPORT IS NOT INSERTED INTO THE BLOCK AND THERE IS C AN IMMEDIATE RETURN TO THE USER. IN THIS CASE, THE VALUE OF C NFLAG DOES NOT CHANGE FROM ITS INPUT VALUE. C C NOTE: ENTRY W3AI05 DUPLICATES PROCESSING IN W3FI66 SINCE NO C ASSEMBLY LANGUAGE CODE IN CRAY W3LIB. C C ATTRIBUTES: C LANGUAGE: CRAY CFT77 FORTRAN C MACHINE: CRAY Y-MP8/832 C C$$$ C CHARACTER*10 COCBUF(*),COCBLK(*) C SAVE C ENTRY W3AI05(COCBUF,COCBLK,NFLAG,NSIZE) C IF (NFLAG.LT.0) THEN PRINT 101 RETURN END IF C N10WRD IS THE MAXIMUM NUMBER OF 10-CHARACTER WORDS AVAILABLE IN BLOCK N10WRD = NSIZE/10 C----------------------------------------------------------------------- IF (NFLAG.EQ.0) THEN C 1ST TIME INTO NEW BLOCK, INTIALIZE ALL 10-CHAR. WORDS AS 'END RECORD' DO 25 M = 1,N10WRD COCBLK(M) = 'END RECORD' 25 CONTINUE END IF C----------------------------------------------------------------------- C READ IN THE NUMBER OF 10-CHARACTER WORDS IN THIS REPORT (NWDS) READ(COCBUF(4)(8:10),30) NWDS 30 FORMAT(I3) C NOW GET THE NUMBER OF CHARACTERS IN THIS REPORT (NCHARS) NCHARS = NWDS * 10 C N01BYT IS THE MAXIMUM NUMBER OF CHARACTERS AVAILABLE FOR DATA IN BLOCK N01BYT = (N10WRD * 10) - 10 IF (NFLAG+NCHARS.GT.N01BYT) THEN C THE REMAINING PORTION OF THE BLOCK IS NOT LARGE ENOUGH TO HOLD THIS C REPORT, RETURN WITH NFLAG = -1 NFLAG = -1 RETURN END IF IF (COCBUF(NWDS).NE.'END REPORT') THEN C LAST 10-CHARACTER WORD IN REPORT IS NOT SET TO THE STRING "END REPORT" C -- INVALID RPT LENGTH, NOTE THIS AND RETURN TO USER W/O BLOCKING RPT PRINT 102, COCBUF(2)(1:6) RETURN END IF C TRANSFER PACKED REPORT INTO BLOCK DO 100 N = 1,NWDS COCBLK((NFLAG/10)+N) = COCBUF(N) 100 CONTINUE C RESET NFLAG NFLAG = NFLAG + (NWDS * 10) RETURN 101 FORMAT(/' *** W3FI66 ERROR- INPUT ARGUMENT "NEXT" (NFLAG) IS ', $ 'LESS THAN ZERO - RECORD IS FULL, WRITE IT OUT AND START FILLING' $,' A NEW RECORD WITH CURRENT REPORT'/) 102 FORMAT(/' *** W3FI66 ERROR- REPORT: ',A6,' DOES NOT END WITH THE', $ ' STRING "END REPORT" - INVALID REPORT LENGTH'/6X,'- CODE WILL ', $ 'MOVE AHEAD TO NEXT REPORT WITHOUT BLOCKING THIS REPORT'/) END