C C THIS FILE CONTAINS ROUTINES TO MAKE VS: DRIVER QIO'S EASY C FROM FORTRAN. C C A CALL TO VS2INI IS REQUIRED, TO INITIALIZE THE LUN AND EFN C PARAMETERS IN THE VS2UTL COMMON BLOCK. (OR, YOU CAN DECLARE C THE COMMON BLOCK AND INITIALIZE IT YOURSELF!) C C ISTAT RECEIVES THE STATUS, AS FOLLOWS: C C ISTAT = 0 IF A DIRECTIVE ERROR OCCURS (SORRY, WE DON'T RETURN C THE DSW, BUT YOU CAN PULL IT FROM VS2UTL!) C ISTAT = (NEGATIVE) I/O STATUS IF AN I/O ERROR OCCURS C ISTAT = (POSITIVE) NUMBER OF BYTES TRANSFERRED, IF SUCCESSFUL C *** NOTE *** IF BYTES TRANSFERRED = 0, ISTAT = +1 C SUBROUTINE VS2INI(ILUN,IIEFN) COMMON /VS2UTL/LUN,IEFN,IOSB(2),IDSW,IPARM(6) LUN=ILUN IEFN=IIEFN CALL ASNLUN(LUN,'VS',0) RETURN END C SUBROUTINE VS2CRQ(QNAME,ISTAT) COMMON /VS2UTL/LUN,IEFN,IOSB(2),IDSW,IPARM(6) EQUIVALENCE(QPARM,IPARM(3)) IPARM(1)=0 IPARM(2)=0 QPARM=QNAME IPARM(5)=0 IPARM(6)=0 CALL VS2QIO("2400,ISTAT) RETURN END C SUBROUTINE VS2FLU(QNAME,ISTAT) COMMON /VS2UTL/LUN,IEFN,IOSB(2),IDSW,IPARM(6) EQUIVALENCE(QPARM,IPARM(3)) IPARM(1)=0 IPARM(2)=0 QPARM=QNAME IPARM(5)=0 IPARM(6)=0 CALL VS2QIO("2500,ISTAT) RETURN END C SUBROUTINE VS2DLQ(QNAME,ISTAT) COMMON /VS2UTL/LUN,IEFN,IOSB(2),IDSW,IPARM(6) EQUIVALENCE(QPARM,IPARM(3)) IPARM(1)=0 IPARM(2)=0 QPARM=QNAME IPARM(5)=0 IPARM(6)=0 CALL VS2QIO("3000,ISTAT) RETURN END C SUBROUTINE VS2CLN(ISTAT) COMMON /VS2UTL/LUN,IEFN,IOSB(2),IDSW,IPARM(6) EQUIVALENCE(QPARM,IPARM(3)) IPARM(1)=0 IPARM(2)=0 QPARM=0.0 IPARM(5)=0 IPARM(6)=0 CALL VS2QIO("3400,ISTAT) RETURN END C SUBROUTINE VS2RLB(QNAME,IBUF,LEN,ISTAT) BYTE IBUF(LEN) COMMON /VS2UTL/LUN,IEFN,IOSB(2),IDSW,IPARM(6) EQUIVALENCE(QPARM,IPARM(3)) CALL GETADR(IPARM(1),IBUF) IPARM(2)=LEN QPARM=QNAME IPARM(5)=0 IPARM(6)=0 CALL VS2QIO("1000,ISTAT) RETURN END C SUBROUTINE VS2WAI(QNAME,IBUF,LEN,ISTAT) BYTE IBUF(LEN) COMMON /VS2UTL/LUN,IEFN,IOSB(2),IDSW,IPARM(6) EQUIVALENCE(QPARM,IPARM(3)) CALL GETADR(IPARM(1),IBUF) IPARM(2)=LEN QPARM=QNAME IPARM(5)=0 IPARM(6)=0 CALL VS2QIO("1200,ISTAT) RETURN END C SUBROUTINE VS2WLB(QNAME,IBUF,LEN,ISTAT) BYTE IBUF(LEN) COMMON /VS2UTL/LUN,IEFN,IOSB(2),IDSW,IPARM(6) EQUIVALENCE(QPARM,IPARM(3)) CALL GETADR(IPARM(1),IBUF) IPARM(2)=LEN QPARM=QNAME IPARM(5)=0 IPARM(6)=0 CALL VS2QIO("400,ISTAT) RETURN END C SUBROUTINE VS2EXM(QNAME,MSGID,IBUF,LEN,ISTAT) BYTE IBUF(LEN) COMMON /VS2UTL/LUN,IEFN,IOSB(2),IDSW,IPARM(6) EQUIVALENCE(QPARM,IPARM(3)) CALL GETADR(IPARM(1),IBUF) IPARM(2)=LEN QPARM=QNAME IPARM(5)=MSGID IPARM(6)=0 CALL VS2QIO("5000,ISTAT) RETURN END C SUBROUTINE VS2DLM(QNAME,MSGID,ISTAT) COMMON /VS2UTL/LUN,IEFN,IOSB(2),IDSW,IPARM(6) EQUIVALENCE(QPARM,IPARM(3)) IPARM(1)=0 IPARM(2)=0 QPARM=QNAME IPARM(5)=MSGID IPARM(6)=0 CALL VS2QIO("5400,ISTAT) RETURN END C SUBROUTINE VS2QIO(IOFUNC,ISTAT) COMMON /VS2UTL/LUN,IEFN,IOSB(2),IDSW,IPARM(6) EQUIVALENCE(QPARM,IPARM(3)) ISTAT=0 IF(LUN.LE.0.OR.IEFN.LE.0)RETURN CALL WTQIO(IOFUNC,LUN,IEFN,,IOSB,IPARM,IDSW) IF(IDSW.NE.1)RETURN ISTAT=IOSB(1).AND."377 IF(ISTAT.NE.1)ISTAT=ISTAT.OR."177400 IF(ISTAT.LE.0)RETURN ISTAT=IOSB(2) IF(ISTAT.EQ.0)ISTAT=1 RETURN END