confp_mf.F

Go to the documentation of this file.

      SUBROUTINE confp_mf (PFVAL,KEXP,KMANT)
      USE parkind1, ONLY : jprb
      USE yomhook , ONLY : lhook, dr_hook
      USE lfi_precision
!
!
!
!
!
!********************************************************************
!*
!*    NAME      : CONFP
!*
!*    FUNCTION  : CONVERT FLOATING POINT NUMBER FROM MACHINE
!*                REPRESENTATION TO GRIB REPRESENTATION.
!*
!*    INPUT     : PFVAL - FLOATING POINT NUMBER TO BE CONVERTED.
!*
!*    OUTPUT    : KEXP  - 8 BIT SIGNED EXPONENT
!*                KMANT - 24 BIT MANTISSA
!*                PFVAL - UNCHANGED.
!*
!*    JOHN HENNESSY , ECMWF , 15TH APRIL 1985
!*
!*    Modified by Jean CLOCHARD, February 1990, to comply with "DOCTOR",
!*    and to get a better precision on the truncation made:
!*       according to FM92 GRIB specification and recommandation,
!*    replacement of "1.0/ALOG(2.0)" by "1.+ZEPS", where ZEPS
!*    is a small positive value avoiding rounding errors to lead to
!*    a mantissa greater than (or equal to) 2**24.
!*
!*    (recommandation: ZEPS=1.E-12 for machines with word length of 60
!*                     bits or more, ZEPS=1.E-8 for 32 bits word length)
!*
!*       Tested with 10**5 pseudo-random values through the RANF
!*    function on Cyber 960 under NOS/VE 1.4.2, the modification gives
!*    an enhancement of more than 10, both on standard deviation and
!*    maximum error. Similar results are obtained when changing test
!*    interval from (0,1) to (-256,256).
!*
!*    Overflowing values are truncated, with a message on the listing.
!*
!********************************************************************
!
      IMPLICIT NONE
!
      INTEGER (KIND=JPLIKM) :: KEXP
      INTEGER (KIND=JPLIKM) :: KMANT
!
      REAL (KIND=JPDBLD) :: PFVAL
!
      INTEGER (KIND=JPLIKM) :: IEXP
!
      REAL (KIND=JPDBLD) :: ZEPS, ZREF, ZC16
!
!RJ       INTRINSIC ABS, LOG, MAX, MIN
!
      SAVE zeps, zc16
      DATA zeps / 1.e-12_jpdbld /
      DATA zc16 / 16.0_jpdbld /
!
!
!
!           Elimination of sign.
!
!
      REAL(KIND=JPRB) :: ZHOOK_HANDLE
      IF (lhook) CALL dr_hook('CONFP_MF',0,zhook_handle)
      zref = abs(pfval)
!
!
!
!     EXPONENT
!
      IF (zref.EQ.0.0_jpdbld) THEN
        kexp = 0
      ELSE
        iexp = int( ( log(zref)/log(zc16) + 65.0_jpdbld ) +zeps )
        kexp= max(0, min(127,iexp))
      ENDIF
!
!
!
!
!
!
!
!     MANTISSA
!
  201 CONTINUE
!
      kmant = nint( zref/(zc16**(kexp-70)) )
!
      IF (kmant.GE.2**24) THEN
!
        IF (kexp.LT.127) THEN
!
!     Some rounding error ocurred in the computation of KEXP, and could
!     not be compensated by ZEPS. Incrementation of KEXP, and new value
!     of KMANT computed.
!
          kexp=kexp+1
          GOTO 201
        ELSE
          print *,                                                      &
     &'*/*/* OVERFLOW OF GRIB FLOATING-POINT REPRESENTATION WITH ',pfval
          kmant=2**24-1
        ENDIF
!
      ENDIF
!
!     ADD SIGN BIT TO EXPONENT.
!
      IF (pfval.LT.0.0_jpdbld) kexp = kexp + 128
!
!
!
!
      IF (lhook) CALL dr_hook('CONFP_MF',1,zhook_handle)
      ENDSUBROUTINE confp_mf