        SUBROUTINE W3AI39 (NFLD, N)
C$$$    SUBPROGRAM DOCUMENTATION  BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    W3AI39      TRANSLATE 'ASCII' FIELD TO 'EBCDIC'
C   PRGMMR: DESMARAIS        ORG: W342       DATE: 93-10-06
C
C ABSTRACT: TRANSLATE AN 'ASCII' FIELD TO 'EBCDIC', ALL ALPHANUMERICS,
C   SPECIAL CHARCATERS, FILL SCATTER, BROCKEN< CLEAR, OVERCAST, BELL,
C   HT AND VT (FOR AFOS). SPACE, '6D' TO '5E' CONVERSION (HDROLOGY),
C   CHANGERS WERE MADE TO W3AI38 TO GIVE REVERSE TABLE TRANSLATION
C
C PROGRAM HISTORY LOG:
C   93-10-06  R.E.JONES   CONVERT IBM370 ASSEBLER VERSION TO FORTRAN
C   94-04-28  R.E.JONES   CHANGES FOR CRAY
C   98-12-21  Gilbert    Replaced Function ICHAR with mova2i.
C
C USAGE:    CALL W3AI39 (NFLD,N)
C   INPUT ARGUMENT LIST:
C     NFLD    - CHARACTER*1 ARRAY OF ASCII DATA
C     N       - INTEGER,  CONTAINS CHARACTER COUNT TO CONVERT....
C
C   OUTPUT ARGUMENT LIST:
C     NFLD     - CHARACTER*1 ARRAY OF EBCDIC DATA
C
C REMARKS: SOFTWARE VERSION OF IBM370 TRANSLATE INSTRUCTION, BY
C   CHANGING THE TABLE WE COULD DO A  64, 96,  ASCII
C   CHARACTER SET, CHANGE LOWER CASE TO UPPER, ETC.
C   TR CONVERT DATA AT A RATE OF 5.4 MILLION CHARACTERS PER SEC.
C   TR IS IN LIBRARY  /USR/LIB/LIBCOS.A   ADD TO SEGLDR CARD.
C
C ATTRIBUTES:
C   LANGUAGE: CRAY CFT77 FORTRAN
C   MACHINE:  CRAY Y-MP8/864
C
C$$$
C
      INTEGER(8)      IEBCDC(32)
C
      CHARACTER*1  NFLD(*)
      CHARACTER*1  EBCDIC(0:255)
C
      SAVE
C
      EQUIVALENCE  (IEBCDC(1),EBCDIC(0))
C
C***  EBCDIC CONTAINS HEX. REPRESENTATION OF EBCDIC CHARACTERS
C
C      DATA  IEBCDC/
C    & X'00010203372D2E2F',X'1605250B0C0D0E0F',
C    & X'101112003C3D3226',X'18193F2722003500',
C    & X'405A7F7B5B6C507D',X'4D5D5C4E6B604B61',
C    & X'F0F1F2F3F4F5F6F7',X'F8F97A5E4C7E6E6F',
C    & X'7CC1C2C3C4C5C6C7',X'C8C9D1D2D3D4D5D6',
C    & X'D7D8D9E2E3E4E5E6',X'E7E8E9ADE0BD5F6D',
C    & X'7981828384858687',X'8889919293949596',
C    & X'979899A2A3A4A5A6',X'A7A8A9C06AD0A107',
C    & 16*X'4040404040404040'/
C
C      THIS TABLE IS THE SAME AS HDS ASSEMBLER VERSION
C
       DATA  IEBCDC/
     & X'007D006C000000E0',X'00657C66004C0000',
     & X'0000000000000000',X'0000000000005B00',
     & X'40D07F7B5000506E',X'4D5D5C4F6B604B61',
     & X'F0F1F2F3F4F5F6F7',X'F8F90000007E00C0',
     & X'64C1C2C3C4C5C6C7',X'C8C9D1D2D3D4D5D6',
     & X'D7D8D9E2E3E4E5E6',X'E7E8E90062636D00',
     & X'0000000000000000',X'0000000000000000',
     & X'0000000000000000',X'000000000000005F',
     & 16 * X'0000000000000000'/
C
      IF (N .LE. 0)   RETURN
C
C***  CONVERT STRING ...  ASCII TO EBCDIC,   N CHARACTERS
C
        DO  20  J = 1, N
          NFLD(J) = EBCDIC(mova2i(NFLD(J)))
 20     CONTINUE
C
      RETURN
      END
