*
* $Id: cfrasccd.F,v 1.1.1.1 1996/03/08 15:21:52 mclareni Exp $
*
* $Log: cfrasccd.F,v $
* Revision 1.1.1.1  1996/03/08 15:21:52  mclareni
* Epio
*
*
#include "epio/pilot.h"
#if defined(CERNLIB_CDC)
      SUBROUTINE CFRASC(IARR,NW)
C.+++++++ CDC VERSION +++++++
C.   ASCII TO INTERNAL CDC ( =DISPLAY ) 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.
#include "epio/asciicdc.inc"
      DIMENSION IARR( 1)
C--- IN ITASC 7 BITS / ASCII CHARACTER, 8 / WORD
C--- IN ITCDC 6 BITS / DISPLAY CH.,     8 / WORD
C     DATA ITCDC/ 4*8H        ,
C    1 8H!"#$ &'(, 8H)*+,-./0, 8H12345678, 8H9:;<=>?@,
C    2 8HABCDEFGH, 8HIJKLMNOP, 8HQRSTUVWX, 8HYZ[ ]^  ,
C    3 8HABCDEFGH, 8HIJKLMNOP, 8HQRSTUVWX, 8HYZ      /
#if defined(CERNLIB_F4)
      DATA ITCDC/ 4*8H        ,
     *66646053556770515555B,52474556465750335555B,34353637404142435555B,
     *44637772547371745555B,01020304050607105555B,11121314151617205555B,
     *21222324252627305555B,31326155627665555555B,01020304050607105555B,
     *11121314151617205555B,21222324252627305555B,31325555555555555555B/
#endif
#if !defined(CERNLIB_F4)
      DATA ITCDC/ 4*8H        ,
     *O"66646053556770515555",O"52474556465750335555",
     *O"34353637404142435555",O"44637772547371745555",
     *O"01020304050607105555",O"11121314151617205555",
     *O"21222324252627305555",O"31326155627665555555",
     *O"01020304050607105555",O"11121314151617205555"
     *O"21222324252627305555",O"31325555555555555555"/
#endif
      DATA IFI/0/, NBASC/32/
      IF(IFI.NE.0)  GOTO 10
C--- INITIALIZE
C    PRESET TO ASCII BLANK
      M=0
      DO 1  I=1,8
    1 M=OR(SHIFT(M,7),NBASC)
      M=SHIFT(M,4)
      DO 2  I=1,8
    2 ITASC(I)=M
      DO 3  I=33,122
      NP=(I-1)/8
      NB=I-8*NP
#if defined(CERNLIB_F4)
      K=AND(SHIFT(ITCDC(NP+1),6*NB),77B)
C--- DO NOT SET BLANK CORR.
      IF(K.EQ.55B)  GOTO 3
#endif
#if !defined(CERNLIB_F4)
      K=AND(SHIFT(ITCDC(NP+1),6*NB),O"77")
C--- DO NOT SET BLANK CORR.
      IF(K.EQ.O"55")  GOTO 3
#endif
      NP=(K-1)/8
      NB=K-8*NP
      KW=SHIFT(ITASC(NP+1),7*NB)
C--- SET ONLY IF NOT YET SET
#if defined(CERNLIB_F4)
      IF(AND(KW,177B).EQ.NBASC)
     1 ITASC(NP+1)=SHIFT(OR(AND(KW,MASK(53)),I),7*(8-NB)+4)
#endif
#if !defined(CERNLIB_F4)
      IF(AND(KW,O"177").EQ.NBASC)
     1 ITASC(NP+1)=SHIFT(OR(AND(KW,MASK(53)),I),7*(8-NB)+4)
#endif
    3 CONTINUE
      IFI=1
   10 CONTINUE
      IF(NW.LE.0)  GOTO 77777
      DO 11  I=1,NW
#if defined(CERNLIB_F4)
      K=AND(IARR(I),177B)
#endif
#if !defined(CERNLIB_F4)
      K=AND(IARR(I),O"177")
#endif
      NP=(K-1)/8
      NB=K-8*NP
#if defined(CERNLIB_F4)
   11 IARR(I)=AND(SHIFT(ITCDC(NP+1),6*NB),77B)
#endif
#if !defined(CERNLIB_F4)
   11 IARR(I)=AND(SHIFT(ITCDC(NP+1),6*NB),O"77")
#endif
77777 RETURN
      END
#endif