*
* $Id: cfrascib.F,v 1.1.1.1 1996/03/08 15:21:51 mclareni Exp $
*
* $Log: cfrascib.F,v $
* Revision 1.1.1.1  1996/03/08 15:21:51  mclareni
* Epio
*
*
#include "epio/pilot.h"
#if defined(CERNLIB_IBM)
      SUBROUTINE CFRASC(IARR,NW)
C.+++++++ IBM VERSION +++++++
C.   ASCII TO INTERNAL IBM ( = EBCDIC ) CODE CONVERSION.
C.   INPUT
C.   NW      NO. OF CHARACTERS TO CONVERT
C.   I/O
C.   IARR    CONTAINS CHARACTERS UNPACKED, RIGHT ADJ., ZERO FILLED
C.           BEFORE AND AFTER CONVERSION IN PLACE.
      DIMENSION IARR( 1)
#include "epio/asciiibm.inc"
      LOGICAL*1 ITASC1(256),LNBASC(4),LK(4),LI(4)
      EQUIVALENCE (K,LK(1)),(II,LI(1)),(NBASC,LNBASC(1))
      EQUIVALENCE (ITASC1(1),ITASC4(1))
      DIMENSION ITIBM4(64)
      LOGICAL*1 ITIBM1(256)
      EQUIVALENCE (ITIBM1(1),ITIBM4(1))
      DATA ITIBM4/
     1  Z40404040, Z40404040, Z40404040, Z40404040,
     2  Z40404040, Z40404040, Z40404040, Z40404040,
     3  Z5A7F7B5B, Z6C507D4D, Z5D5C4E6B, Z604B61F0,
     4  ZF1F2F3F4, ZF5F6F7F8, ZF97A5E4C, Z7E6E6F7C,
     5  ZC1C2C3C4, ZC5C6C7C8, ZC9D1D2D3, ZD4D5D6D7,
     6  ZD8D9E2E3, ZE4E5E6E7, ZE8E9ADE0, ZBD6A6D79,
     7  Z81828384, Z85868788, Z89919293, Z94959697,
     8  Z9899A2A3, ZA4A5A6A7, ZA8A98B4F, Z9B5F4040,
     9  32*Z40404040/
      DATA IFI /0/, NBASC /32/, K/0/
      IF(IFI.NE.0)  GOTO 10
C--- INITIALIZE
      CALL UCOPY(ITIBM4,IFASC4,64)
C    PRESET TO ASCII BLANK
      DO 1  I=1,256
    1 ITASC1(I)= LNBASC(4)
C--- FILL
      DO 2  I=33,126
      LK(4)= ITIBM1(I)
      II= I
    2 ITASC1(K)= LI(4)
      IFI=1
   10 CONTINUE
      IF(NW.LE.0)  GOTO 77777
      DO 11  J=1,NW
      I= MIN0 (256,MAX0(1,IARR(J)))
      LK(4)= ITIBM1(I)
   11 IARR(J)= K
77777 RETURN
      END
#endif