C This file: http://ftp.aset.psu.edu/pub/ger/fortran/hdk/ieee2ibm.for
C
      REAL X(20),Y(20)
      INTEGER I, LRECL, N
      CHARACTER*80 REC
      EQUIVALENCE (X(1),REC)
      CALL FILEINF(IRC,'RECFM','U','LRECL',32760,'BLKSIZE',32760)
      OPEN(60,FILE='/VWRITE DATA E',FORM='UNFORMATTED')
      READ(60,NUM=LRECL) REC
      WRITE(6,*)'LRECL=',LRECL
      N=LRECL/4
      DO 1 I=1,N
1     CALL SP2IBM(X,Y,N,1)
      WRITE(6,*)'Y=',(Y(I),I=1,N)
      STOP
      END
      SUBROUTINE SP2IBM(X,Y,N,INC)
      REAL X(1),Y(N), R
C**********************************************************************
C  ROUTINE:   SP2IBM
C  PURPOSE:   Converts an N-vector, X of Single precision numbers in
C             IEEE floating-point representation To IBM single
C             precision N-vector, Y. The arguments corresponding to X
C             and Y may be the same variable; e.g. CALL SP2IBM(X,X,288)
C  PACKAGE:   IEEE Conversion Routines.
C  SPEED:     >250,000 numbers per CPU second when N>10 per CALL using
C             VS Fortran OPT(3) on the IBM 3090-600.
C  CALLS:     IBM's builtin routine, ISHFT.
C  AUTHORS:   Mary Jo P. Bojan <BOJAN@PSUCHEM.PSU.EDU>
C             H. D. Knoble     hdkLESS at SPAM psu dot edu   08/26/88
C  REVISIONS:
C
C  Statement of the authors' intent:
C  SP2IBM may be freely copied by anyone under the condition that it be
C  used specifically and only for peaceful purposes - namely for work
C  which in no way threatens human dignity or life.
C**********************************************************************
      DOUBLE PRECISION NORMAL
      INTEGER IX,FRAC,IEXP,INC,OFFSET
      EQUIVALENCE(R,IX)
      DATA NORMAL /8388607.D0/
C                  2**23-1 used to normalize the 23 bit fraction, FRAC.
      OFFSET=1-INC
      DO 1 I=1,N
        OFFSET=OFFSET+INC
        R=X(OFFSET)
        FRAC=IX/2**8
        IEXP=ISHFT(ISHFT(IX,24),-24)-128
        WRITE(6,*) FRAC,IEXP
        Y(I)=(FRAC/NORMAL)*2.D0**IEXP
1     CONTINUE
      RETURN
      END