C                  INTERNATIONAL AVS CENTER
C        (This disclaimer must remain at the top of all files)
C
C WARRANTY DISCLAIMER
C
C This module and the files associated with it are distributed free of charge.
C It is placed in the public domain and permission is granted for anyone to use,
C duplicate, modify, and redistribute it unless otherwise noted.  Some modules
C may be copyrighted.  You agree to abide by the conditions also included in
C the AVS Licensing Agreement, version 1.0, located in the main module
C directory located at the International AVS Center ftp site and to include
C the AVS Licensing Agreement when you distribute any files downloaded from
C that site.
C
C The International AVS Center, MCNC, the AVS Consortium and the individual
C submitting the module and files associated with said module provide absolutely
C NO WARRANTY OF ANY KIND with respect to this software.  The entire risk as to
C the quality and performance of this software is with the user.  IN NO EVENT
C WILL The International AVS Center, MCNC, the AVS Consortium and the individual
C submitting the module and files associated with said module BE LIABLE TO
C ANYONE FOR ANY DAMAGES ARISING FROM THE USE OF THIS SOFTWARE, INCLUDING,
C WITHOUT LIMITATION, DAMAGES RESULTING FROM LOST DATA OR LOST PROFITS, OR ANY
C SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES.
C
C This AVS module and associated files are public domain software unless
C otherwise noted.  Permission is hereby granted to do whatever you like with
C it, subject to the conditions that may exist in copyrighted materials. Should
C you wish to make a contribution toward the improvement, modification, or
C general performance of this module, please send us your comments:  why you
C liked or disliked it, how you use it, and most important, how it helps your
C work. We will receive your comments at avs@ncsc.org.
C
C Please send AVS module bug reports to avs@ncsc.org.
C
      subroutine ebcdic(string)
*                =====
*     ASCII->EBCDIC conversion
*     ------------------------
      implicit integer (a-z)
      logical start
      dimension convert(128)
      character table(8)*32
      character string*(*)
      data start / .true. /
      data table /
*        O 1 2 3 4 5 6 7 8 9 a b c d e f
     O '00010203372d2e2f1605250b0c0d0e0f',
     1 '101112133c3d322618193f271c1d1e1f',
     2 '405a7f7b5b6c507d4d5d5c4e6b604b61',
     3 'f0f1f2f3f4f5f6f7f8f97a5e4c7e6e6f',
     4 '7cc1c2c3c4c5c6c7c8c9d1d2d3d4d5d6',
     5 'd7d8d9e2e3e4e5e6e7e8e9ade0bd5f6d',
     6 '79818283848586878889919293949596',
     7 '979899a2a3a4a5a6a7a8a9c04fd0a107'/
*
* ... Construct tables at start ...
      if(start) then
         do 10 k=1,128
         j=(k-1)/16+1
         i=2*mod(k-1,16)+1
         read(table(j)(i:i+1),'(z2)') item
         convert(k)=item
   10    continue
         start=.false.
      endif
*
* ... Perform function ...
      do 20 k=1,len(string)
      kode=ichar(string(k:k))+1
   20 string(k:k)=char(convert(kode))
      return
      end