w3fi76.f

Go to the documentation of this file.

C> @file
C> @brief Convert to ibm370 floating point
C> @author John Hennessy @date 1985-09-15
 
C> Converts floating point number from machine
C> representation to grib representation (ibm370 32 bit f.p.).
C>
C> Program history log:
C> - John Hennessy 1985-09-15
C> - Ralph Jones 1992-09-23 Change name, add doc block
C> - Ralph Jones 1993-10-27 Change to agree with hennessy changes
C> - Mark Iredell 1995-10-31 Removed saves and prints
C> - Boi Vuong 1998-03-10 Remove the cdir$ integer=64 directive
C>
C> @param[in] PVAL Floating point number to be converted
C> @param[in] KBITS Number of bits in computer word (32 or 64)
C> @param[out] KEXP 8 Bit signed exponent
C> @param[out] KMANT 24 Bit mantissa (fraction)
C>
C> @note Subprogram can be called from a multiprocessing environment.
C>
C> @author John Hennessy @date 1985-09-15
      SUBROUTINE w3fi76(PVAL,KEXP,KMANT,KBITS)
C
C********************************************************************
C*
C*    NAME      : CONFP3
C*
C*    FUNCTION  : CONVERT FLOATING POINT NUMBER FROM MACHINE
C*                REPRESENTATION TO GRIB REPRESENTATION.
C*
C*    INPUT     : PVAL  - FLOATING POINT NUMBER TO BE CONVERTED.
C*    KBITS     : KBITS - NUMBER OF BITS IN COMPUTER WORD
C*
C*    OUTPUT    : KEXP  - 8 BIT SIGNED EXPONENT
C*                KMANT - 24 BIT MANTISSA
C*                PVAL  - UNCHANGED.
C*
C*    JOHN HENNESSY , ECMWF   18.06.91
C*
C********************************************************************
C
C
C     IMPLICIT NONE
C
      INTEGER IEXP
      INTEGER ISIGN
C
      INTEGER KBITS
      INTEGER KEXP
      INTEGER KMANT
C
      REAL PVAL
      REAL ZEPS
      REAL ZREF
C
C     TEST FOR FLOATING POINT ZERO
C
      IF (pval.EQ.0.0) THEN
        kexp  = 0
        kmant = 0
        GO TO 900
      ENDIF
C
C     SET ZEPS TO 1.0E-12 FOR 64 BIT COMPUTERS (CRAY)
C     SET ZEPS TO 1.0E-8  FOR 32 BIT COMPUTERS
C
      IF (kbits.EQ.32) THEN
        zeps = 1.0e-8
      ELSE
        zeps = 1.0e-12
      ENDIF
      zref = pval
C
C     SIGN OF VALUE
C
      isign = 0
      IF (zref.LT.0.0) THEN
        isign =   128
        zref    = - zref
      ENDIF
C
C     EXPONENT
C
      iexp = int(alog(zref)*(1.0/alog(16.0))+64.0+1.0+zeps)
C
      IF (iexp.LT.0  ) iexp = 0
      IF (iexp.GT.127) iexp = 127
C
C     MANTISSA
C
C     CLOSEST NUMBER IN GRIB FORMAT TO ORIGINAL NUMBER
C     (EQUAL TO, GREATER THAN OR LESS THAN ORIGINAL NUMBER).
C
      kmant = nint(zref/16.0**(iexp-70))
C
C     CHECK THAT MANTISSA VALUE DOES NOT EXCEED 24 BITS
C     16777215 = 2**24 - 1
C
      IF (kmant.GT.16777215) THEN
         iexp  = iexp + 1
C
C     CLOSEST NUMBER IN GRIB FORMAT TO ORIGINAL NUMBER
C     (EQUAL TO, GREATER THAN OR LESS THAN ORIGINAL NUMBER).
C
         kmant = nint(zref/16.0**(iexp-70))
C
C        CHECK MANTISSA VALUE DOES NOT EXCEED 24 BITS AGAIN
C
         IF (kmant.GT.16777215) THEN
           print *,'BAD MANTISSA VALUE FOR PVAL = ',pval
         ENDIF
      ENDIF
C
C     ADD SIGN BIT TO EXPONENT.
C
      kexp = iexp + isign
C
  900 CONTINUE
C
      RETURN
      END