CTITLEUSASEB -- CONVERT ASCII TO EBCDIC
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA    AUTHOR                 NARENDRA SHETH
CA    DESIGNER               NARENDRA SHETH
CA    LANGUAGE               S/370 FORTRAN H EXTENDED
CA    WRITTEN                07/05/83
C     REVISED
CA
CA
CA       CALL USASEB( INSTR, INC, OUTSTR, OUTC, NUM )
CA
CA       INPUT      INSTR    I2   SOURCE ASCII CHARACTER STRING.
CA       INPUT      INC      I4   SOURCE CHARACTER INDEX.
CA                                1 IS THE FIRST CHARACTER IN INSTR.
CA       OUTPUT     OUTSTR   I2   DESTINATION CHARACTER STRING FOR
CA                                EBCDIC CHARACTERS.
CA       OUTPUT     OUTC     I4   DESTINATION STRING INDEX.
CA                                1  IS THE FIRST CHARACTER IN INSTR.
CA       INPUT      NUM      I4   NUMBER OF CHARACTERS TO CONVERT.
CA
CA
CAEND
C
      SUBROUTINE  USASEB(INSTR, INC, OUTSTR, OUTC, NUM )
C
C
      IMPLICIT INTEGER ( A- Z )
      INTEGER   INSTR( 1), OUTSTR( 1)
      INTEGER  CTAB(32) /Z40404040, Z40404040, Z40404040, Z40404040,
     *                   Z40404040, Z40404040, Z40404040, Z40404040,
     *                   Z405A7F7B, Z5B6C507D, Z4D5D5C4E, Z6B604B61,
     *                   ZF0F1F2F3, ZF4F5F6F7, ZF8F97A5E, Z4C7E6E6F,
     *                   Z7CC1C2C3, ZC4C5C6C7, ZC8C9D1D2, ZD3D4D5D6,
     *                   ZD7D8D9E2, ZE3E4E5E6, ZE7E8E940, Z4040406D,
     *                   Z40404040, Z40404040, Z40404040, Z40404040,
     *                   Z40404040, Z40404040, Z40404040, Z40404040/
C
C
      DO 100 J = 1, NUM
         ITEMP = 0
         IBX   = INC + J - 1
C
C        MOVE THE INPUT BYTE TO ITEMP AND NORMALIZE IT
C
   10    CALL S1MVCH ( INSTR, IBX, ITEMP, 4 , 1)
         IF ( ITEMP .LE. 127) GO TO                                 20
         ITEMP = ITEMP - 128
   20    ITEMP = ITEMP + 1
         IBX  = OUTC + J - 1
C
C        MOVE THE CORRECT EBCDIC VALUE FROM THE CHARACTER TABLE TO
C        THE OUTPUT STRING.
C
         CALL S1MVCH( CTAB, ITEMP, OUTSTR, IBX, 1 )
  100    CONTINUE
         RETURN
         END