confi.F

Go to the documentation of this file.

      SUBROUTINE confi (PFVAL,KEXP,KMANT,PNFVAL)
      USE parkind1, ONLY : jprb
      USE yomhook , ONLY : lhook, dr_hook
      USE lfi_precision
!
!
!
!
!
!********************************************************************
!*
!*    NAME      : CONFI
!*
!*    FUNCTION  : CONVERT FLOATING POINT NUMBER FROM MACHINE
!*                REPRESENTATION TO GRIB REPRESENTATION,
!*                THE RESULT NUMBER NOT EXCEEDING THE INPUT NUMBER.
!*    INPUT     : PFVAL  - FLOATING POINT NUMBER TO BE CONVERTED.
!*
!*    OUTPUT    : KEXP   - 8 BIT SIGNED EXPONENT
!*                KMANT  - 24 BIT MANTISSA
!*                PFVAL  - UNCHANGED
!*                PNFVAL - "EXACT" VALUE REPRESENTED BY (KEXP,KMANT).
!*
!*    Jean CLOCHARD , French DMN, January 1990.
!*    Nearly rewritten from CONFP subroutine from John HENNESSY, ECMWF.
!*
!*    Overflowing values are truncated, with a message on the listing.
!*
!********************************************************************
!
      IMPLICIT NONE
!
      INTEGER (KIND=JPLIKM) :: kexp
      INTEGER (KIND=JPLIKM) :: KMANT
!
      REAL (KIND=JPDBLD) :: PFVAL
      REAL (KIND=JPDBLD) :: PNFVAL
!
      INTEGER (KIND=JPLIKM) :: IAUXIL, IEXP
!
      REAL (KIND=JPDBLD) :: ZEPS, ZREF, ZC16, ZMANT
!
      LOGICAL :: LLPOSI
!
!RJ       INTRINSIC LOG, ABS, MIN, MAX, INT
!
      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('CONFI',0,zhook_handle)
      llposi=pfval.GE.0.0_jpdbld
      zref = abs(pfval)
!
!
!
!
!     EXPONENT
!
      IF (zref.EQ.0.0_jpdbld) THEN
        kexp = 0
      ELSE
        iexp = int((log(zref)/log(16.0_jpdbld) + 65.0_jpdbld) +zeps)
        kexp= max(0, min(127,iexp))
      ENDIF
!
!
!
!
!
!
!     MANTISSA
!
  201 CONTINUE
!
      zmant = zref/(zc16**(kexp-70))
!
      IF (llposi) THEN
        kmant=int(zmant)
      ELSE
!
!        Special case for negative values... because the "INT" function
!     is not equivalent to the "integer part" mathematical function
!     for this range of values.
!
        iauxil=2+int(zmant)
        kmant=iauxil - int( -zmant + REAL (IAUXIL,JPDBLD) )
      ENDIF
!
      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
!
!     COMPUTE "EXACT" VALUE REPRESENTED, AND ADD SIGN BIT TO EXPONENT.
!
      IF (llposi) THEN
        pnfval =  kmant*(zc16**(kexp-70))
      ELSE
        pnfval = -kmant*(zc16**(kexp-70))
        kexp=kexp+128
      ENDIF
!
!
      IF (lhook) CALL dr_hook('CONFI',1,zhook_handle)
      ENDSUBROUTINE confi