*
* $Id: kaxrclml.s,v 1.1.1.1 1996/03/08 11:40:55 mclareni Exp $
*
* $Log: kaxrclml.s,v $
* Revision 1.1.1.1  1996/03/08 11:40:55  mclareni
* Kapack
*
*
#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_QMIBMXA))
         TITLE 'KAXRCL'
***********************************************************************
*                                                                     *
*                             K A X R C L                             *
*                             ===========                             *
*                                                                     *
***********************************************************************
*                                                                     *
* FUNCTION:     OBTAIN THE BLOCKSIZE OF A DIRECT ACCESS FILE FOR USE  *
*               BY KAPACK.  THE BLOCKSIZE IS RETURNED IN THE UNITS    *
*               REQUIRED BY THE FORTRAN OPEN STATEMENT FOR            *
*               UNFORMATTED DIRECT ACCESS FILES, (I.E. BYTES ON IBM). *
*               IN THE EVENT OF AN ERROR A LENGTH OF ZERO WILL BE     *
*               RETURNED.                                             *
*                                                                     *
* CALLING SEQUENCE:     LENGTH = KAXRCL(LUN)                          *
*                                                                     *
* ARGUMENTS:     LUN - AN INTEGER EXPRESSION WHOSE VALUE REPRESENTS   *
*                      THE NUMBER OF THE UNIT TO WHICH THE FILE IS    *
*                      CONNECTED.                                     *
*                                                                     *
***********************************************************************
         EJECT
***********************************************************************
*                                                                     *
*                   M O D I F I C A T I O N   L O G                   *
*                   ===============================                   *
*                                                                     *
***********************************************************************
*                                                                     *
*                               1 . 0 1                               *
*                               =======                               *
*                                                                     *
* DCBOFOPN REPLACED BY X'10' FOR COMPATIBILITY WITH CMS DCBD MACRO.   *
*                                                                     *
* R. MATTHEWS, CERN/DD, APRIL 1985.                                   *
*                                                                     *
***********************************************************************
*                                                                     *
*                               1 . 0 0                               *
*                               =======                               *
*                                                                     *
* ORIGINAL VERSION.                                                   *
*                                                                     *
* R. MATTHEWS, CERN/DD, JULY 1982.                                    *
*                                                                     *
***********************************************************************
         EJECT
R0       EQU   0
R1       EQU   1
R2       EQU   2
R3       EQU   3
R4       EQU   4
R5       EQU   5
R6       EQU   6
R7       EQU   7
R8       EQU   8
R9       EQU   9
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
         EJECT
         PRINT NOGEN
KAXRCL   CSECT
         SPACE 2
*  P R O L O G U E
         SPACE
         USING KAXRCL,R15
         B     SAVEREGS
         DC    AL1(7),CL7'KAXRCL'    IDENTIFIER
         DC    C'1.01'               VERSION.MODIFICATION LEVEL
SAVEREGS STM   R14,R12,12(R13)
         LR    R4,R13
         CNOP  0,4
         BAL   R13,AROUNDSA
SAVEAREA DC    A(EPILOGUE),17F'0'
         DROP  R15
         USING SAVEAREA,R13
AROUNDSA ST    R13,8(0,R4)
         ST    R4,4(0,R13)
         XC    8(4,R13),8(R13)
         SPACE
         LR    R11,R1         R11 -> ARGUMENT LIST
         LA    R10,DCB        R10 -> DCB
         USING IHADCB,R10     ESTABLISH ADDRESSABILITY OF THE DCB
         SPACE 2
*  G E N E R A T E   T H E   D D N A M E
         SPACE
         L     R2,0(0,R11)    R2 -> UNIT IDENTIFIER
         L     R2,0(0,R2)     R2 := UNIT IDENTIFIER
         CVD   R2,DOUBLE      CONVERT IT TO EBCDIC...
         MVC   EDITAREA(L'PATTERN1),PATTERN1
         ED    EDITAREA(L'PATTERN1),DOUBLE+6
         MVC   DCBDDNAM+2(2),EDITAREA+1  MOVE IT INTO THE DCB
         SPACE 2
*  O P E N   T H E   D C B
         SPACE
         XC    DOUBLE,DOUBLE  SET DEFAULT LENGTH
         OPEN  DCB
         TM    DCBOFLGS,X'10' WAS THE OPEN SUCCESSFUL ?
         BNO   EPILOGUE       NO, BRANCH
         SPACE 2
*  G E T   T H E   B L O C K S I Z E
         SPACE
         LH    R2,DCBBLKSI    R2 := BLOCKSIZE
         ST    R2,DOUBLE      STORE IT
         SPACE 2
*  C L O S E   T H E   D C B
         SPACE
         CLOSE DCB
         EJECT
*  E P I L O G U E
         SPACE
EPILOGUE EQU   *
         L     R0,DOUBLE      LOAD THE RESULT
         L     R13,4(0,R13)
         L     R14,12(0,R13)
         LM    R1,R12,24(R13)
         MVI   12(R13),X'FF'
         BR    R14
         EJECT
*  D A T A   A R E A S
         SPACE
DOUBLE   DS    D
         SPACE
EDITAREA DS    3C
PATTERN1 DC    X'212020'
         SPACE
DCB      DCB   DDNAME=FT??F001,DSORG=PS,MACRF=(R)
         SPACE 2
         LTORG
         SPACE 2
         DCBD  DSORG=PS
         SPACE 2
         END
#endif