C C SUBROUTINE WRITW C C C FUNCTION: WRITW WRITES A SPECIFIED NUMBER OF WORDS FROM C A BUFFER ,CHECKS FOR ALL POSSIBLE ERRORS THEN RETURNS C C C AUTHOR: G. GUELFI 1-APRIL-1985 C C C CALL IS C C CALL WRITW(IWCNT,IQ,IBLK,ICHAN) C C WHERE C C IWCNT IS NUMBER OF WORDS TO BE WRITTEN C IQ IS BUFFER TO HOLD WORDS C IBLK IS BLOCK TO START WRITING FROM C ICHAN IS CHANNEL FOR WRITE C C SUBROUTINE WRITW(IWCNT,IQ,IBLK,ICHAN) DIMENSION IQ(IWCNT) C CALL SCCA(NFLAG) CALL WRTERR(IWRITW(IWCNT,IQ,IBLK,ICHAN),IWRT,0) C CALL SCCA(NFLAG) IBLK = IBLK + IWRT/256 RETURN END C C SUBROUTINE WRTERR C C FUNCTION : TO CHECK THE RETURNED FUNCTION CODE AFTER THE IWRITE C HAS BEEN PERFORMED AND TO REPORT ALL POSSIBLE ERRORS . C C ON ERROR THE PROGRAM CAN GENERATE A DIVIDE BY ZERO TO C GIVE A TRACE BACK . C C C C AUTHOR: G. GUELFI 1-APRIL-1985 C C C CALL IS C C SUBROUTINE WRTERR(ICODE,IWRT,NUM) C C WHERE C C ICODE IS IWRITE FUNCTION VALUE C IWRT CAN CONTAIN ERROR VALUE TO BE IGNORED C AND IT RETURNS VALUE OF ICODE C NUM IS VALUE TO GENERATE TRACE BACK C C IF NUM = 0 THEN TRACE BACK C IF NUM = 1 ONLY REPORT ERROR C SUBROUTINE WRTERR(ICODE,IWRT,NUM) C C C ERROR MESSAGES FOR IWRITE C IF (ICODE.GE.0.OR.ICODE.EQ.IWRT) GOTO 100 D DO 1 I = 1,14 D J = I - 1 D CALL CLOSEC(J) D1 CALL IFREEC(J) TYPE *,ICODE,' IWRITE ERROR ' D IF (ICODE.EQ.-1) TYPE *,'WRITE PASS EOF' D IF (ICODE.EQ.-2) TYPE *,'HWD ERR ON CHAN' D IF (ICODE.EQ.-3) TYPE *,'CHAN NOT OPEN' R = 1./NUM 100 IWRT = ICODE RETURN END