d       SUBROUTINE WRTVBS(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),IND,BYTE(2),OK
      EQUIVALENCE (IWORD,BYTE(1))
x      DATA IOWLB/'20'X/,INORM/1/
Ü    1 FORMAT (' ERROR IN WRITE ***'/'0CODE ='Z6,','I6,
@     1 ' CHARACTERS WRITTEN'/'$SHALL WE CONTINUE? (T/F)  ')
¤    2 FORMAT (L1)
      IF (OEOF) GO TO 25
l      ILRECL = OLRECL
Ð      IND = 0
4      IF (ORC .NE. 4) GO TO 15
˜   10 DO 11 J=1,OBLKSZ
ü   11 OUTPUT(J) = 0
`	   15 MLRECL = OBLKSZ - ORC - 4
Ä	      MLRECL = MIN0(MLRECL,ILRECL)
(
      DO 17 J=1,MLRECL
Œ
   17 OUTPUT(ORC+J+4) = LRECRD(ORECL-ILRECL+J)
ð
      IF (MLRECL .LT. ILRECL) IND = IND .OR. 1
T      O = ORC + MLRECL + 4
¸      ILRECL = ILRECL - MLRECL
      MLRECL = MLRECL + 4
€      IWORD = MLRECL
ä      OUTPUT(ORC+1) = BYTE(2)
H      OUTPUT(ORC+2) = BYTE(1)
¬      OUTPUT(ORC+3) = IND
      OUTPUT(ORC+4) = 0
t      ORC = O
Ø      IF (ORC+5 .LT. OBLKSZ) RETURN
<   25 IWORD = ORC
       OUTPUT(1) = BYTE(2)
      OUTPUT(2) = BYTE(1)
h      OUTPUT(3) = 0
Ì      OUTPUT(4) = 0
0C      AND NOW TO WRITE A RECORD
”      CALL SYS$QIOW(,%VAL(LUNMT),%VAL(IOWLB),OSTAT,,,OUTPUT,
ø     1 %VAL(ORC),,,,)
\      OEOF = .FALSE.
À      OBC = OBC + 1	!UPDATE RECORD COUNT
$      ORC = 4		!RESET BYTE POINTER IN BUFFER
ˆ      IND = 2		!SET IN CASE THE RECORD IS SPANNED
ì      IF (OSTAT(1) .EQ. INORM) GO TO 40	! INORM MEANS ALL IS WELL
P      WRITE (LUNTT,1) OSTAT(1),OSTAT(2)	! DARN
´      READ (LUNTT,2) OK
      IF (.NOT.OK) OEOF = .TRUE.	!FLAG IT FOR CALLING PROGRAM
|   40 IF (ILRECL .GT. 0) GO TO 10 	!IF MORE TO RECORD, GO BACK
à      RETURN
D      END