d       SUBROUTINE WRT370(LRECRD)
È CHANGES MADE 30-Jul-1981 ***
,C
C      SUBROUTINE TO DO THE ACTUAL WRITE ON 'TAPE'.
ôC
X      IMPLICIT INTEGER*2 (I-N,O)
¼      COMMON /GHCITP/ IRC,IBC,LUNMT,LUNTT,ILRECL,IBLKSZ,IOSTAT(5),
      1 IFN(17),IVOL(6),TRAN,LAB,IEOF
„      COMMON /GHCOTP/ ORC,OBC,OLRECL,OBLKSZ,OSTAT(4),OFN(17),
è     1 VNAME(6),OTRAN,OLAB,CC,ODEN,OEOF
L      LOGICAL*1 IFN,TRAN,LAB,IEOF,OFN,OTRAN,OLAB,CC,ODEN,OEOF,VNAME,IVOL
°      LOGICAL*1 LRECRD(1),OUTPUT(8000)
      DATA IOWLB/'20'X/,INORM/1/
x    1 FORMAT (' ERROR IN WRITE ***'/'0CODE ='Z6,','I6,
Ü     1 ' CHARACTERS WRITTEN'/'$SHALL WE CONTINUE? (T/F)  ')
@    2 FORMAT (L1)
¤      IF (OEOF) GO TO 35
      IF (OTRAN) GO TO 10
l      DO 5 J=1,OLRECL
Ð    5 OUTPUT(ORC+J) = LRECRD(J)
4      GO TO 30
˜   10 CALL ASTEBC(OLRECL,LRECRD,OUTPUT(ORC+1))
ü   30 ORC = ORC + OLRECL
`	      IF (ORC .LT. OBLKSZ) RETURN
Ä	C      AND NOW TO WRITE A RECORD
(
   35 CALL SYS$QIOW(,%VAL(LUNMT),%VAL(IOWLB),OSTAT,,,OUTPUT,
Œ
     1 %VAL(ORC),,,,)
ð
      OEOF = .FALSE.
T      IF (OSTAT(1) .EQ. INORM) GO TO 40
¸C      DARN !
      WRITE (LUNTT,1) OSTAT(1),OSTAT(2)
€	READ (LUNTT,2) OK
ä      IF (.NOT.OK) OEOF = .TRUE.
H   40 OBC = OBC + 1
¬      ORC = 0
      RETURN
t      END