*
* $Id: vmrtrm.s,v 1.1.1.1 1996/02/15 17:51:55 mclareni Exp $
*
* $Log: vmrtrm.s,v $
* Revision 1.1.1.1  1996/02/15 17:51:55  mclareni
* Kernlib
*
*
         PRINT NOGEN
VMRTRM   CSECT
#if defined(CERNLIB_QMIBMXA)
VMRTRM  AMODE ANY
VMRTRM  RMODE ANY
#endif
*
* CERN PROGLIB# Z305    VMRTRM          .VERSION KERNIBM  2.23  880425
* ORIG. 19/09/87  HRR
*
*     TITLE 'VMRTRM    READ DATA FROM THE CONSOLE IN CMS FOR FORTRAN77'
*
*     A. BANKS (WITH ENTRY NAME RDTERM)
*
*     CALL FROM FORTRAN 77 IS:
*     CALL VMRTRM(STRING[,LENGTH])
*
*     STRING (RETURNED) CHARACTER*(*) THE STRING READ
*     LENGTH (RETURNED) INTEGER*4     THE SMALLER LENGTH OF EITHER THE
*                                     CHARACTER STRING LENGTH, OR THE
*                                     LENGTH OF STRING ACTUALLY READ.
*                                     SURPLUS CHARACTERS ENTERED ARE
*                                     IGNORED. STRING IS BLANK PADDED.
*
*     Modified to use LINERD for XA compatibility
*     Tony Cass  CERN/DD    May 1989
*
        USING VMRTRM,R15 ESTABLISH ADDRESSABILITY
        DS    0H         ALIGN
        B     VMRTRMN    BRANCH AROUND THE NAME
        DC    AL1(7)     LENGTH OF NAME
        DC    C'VMRTRM'  DEFINE THE NAME
VMRTRMN SAVE  (14,12)    SAVE THE REGS
        LR    R12,R15    SET UP THE BASE
        DROP  R15        ADDRESSABILITY REESTABLISHED
        USING VMRTRM,R12 ESTABLISH ADDRESSABILITY
        L     R2,0(R1)   POINTER TO CHAR STRING ADDRESS
        LR    R3,R1      COPY R1
        S     R3,=F'4'   POINT TO ARG LENGTH BLOCK DISPLACEMENT
        L     R3,0(R3)   PICK UP THE ARG LEN BLOCK DISPLACEMENT
        AR    R3,R1      COMPUTE THE ARG LEN BLOCK ADDRESS
        L     R3,0(R3)   GET LENGTH POINTER ADDRESS
        L     R3,0(R3)   GET THE LENGTH OF THE CHAR VARIABLE
        LA    R6,LREAD   DEFAULT LENGTH OF STRING READ
        TM    0(R1),X'80' IS THERE A SECOND ARG
        BO    ENDARG2    BRANCH IF NO SECOND ARG
        L     R6,4(R1)   POINT R6 AT LENGTH ADDRESS
*                        NOW DO THE READ
#if defined(CERNLIB_QMIBMXA)
ENDARG2 LINERD DATA=((R2),(R3)),CASE=MIXED,TYPE=STACK,WAIT=YES
        ST    R0,0(R6)   SAVE THE LENGTH ACTUALLY READ
#endif
#if !defined(CERNLIB_QMIBMXA)
ENDARG2 RDTERM (R2),EDIT=PHYS,LENGTH=(R3),ATTREST=NO
        ST    R0,0(R6)   SAVE THE LENGTH ACTUALLY READ
*                        SET THE REST OF THE STRING TO TRAILING BLANKS
        AR    R2,R0      POINT R2 TO THE NEXT UNREAD CHAR
        SR    R3,R0      SET R3 TO COUNT BLANKS REQUIRED
        LA    R4,0       R4 UNIMPORTANT
        L     R5,BLANKR5 PUT BLANK PAD INTO R5
        MVCL  R2,R4      CLEAR REMAINING CHARS TO BLANKS
#endif
        RETURN (14,12)   GO BACK TO THE FORTRAN
*
*       DATA AREAS
LREAD   DS    1F         DUMMY LENGTH READ
BLANKR5 DC    C' ',X'000000' BLANK CHAR OF ZERO LENGTH
*
        REGEQU
        END