SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/XRD38/grib

Go to the documentation of this file.
00001       SUBROUTINE CONFI (PFVAL,KEXP,KMANT,PNFVAL)
00002       USE PARKIND1, ONLY : JPRB
00003       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00004 C
00005 C
00006 C
00007 C
00008 C
00009 C********************************************************************
00010 C*
00011 C*    NAME      : CONFI
00012 C*
00013 C*    FUNCTION  : CONVERT FLOATING POINT NUMBER FROM MACHINE
00014 C*                REPRESENTATION TO GRIB REPRESENTATION,
00015 C*                THE RESULT NUMBER NOT EXCEEDING THE INPUT NUMBER.
00016 C*    INPUT     : PFVAL  - FLOATING POINT NUMBER TO BE CONVERTED.
00017 C*
00018 C*    OUTPUT    : KEXP   - 8 BIT SIGNED EXPONENT
00019 C*                KMANT  - 24 BIT MANTISSA
00020 C*                PFVAL  - UNCHANGED
00021 C*                PNFVAL - "EXACT" VALUE REPRESENTED BY (KEXP,KMANT).
00022 C*
00023 C*    Jean CLOCHARD , French DMN, January 1990.
00024 C*    Nearly rewritten from CONFP subroutine from John HENNESSY, ECMWF.
00025 C*
00026 C*    Overflowing values are truncated, with a message on the listing.
00027 C*
00028 C********************************************************************
00029 C
00030 #include "precision.h"
00031 C
00032       INTEGER KEXP, KMANT
00033 C
00034       REAL (KIND=JPDBLR) PFVAL, PNFVAL
00035 C
00036       INTEGER IAUXIL, IEXP
00037 C
00038       REAL (KIND=JPDBLR) ZEPS, ZREF, ZC16, ZMANT
00039 C
00040       LOGICAL LLPOSI
00041 C
00042       INTRINSIC LOG, ABS, MIN, MAX, INT
00043 C
00044       SAVE ZEPS, ZC16
00045       DATA ZEPS / 1.E-12 /
00046       DATA ZC16 / 16. /
00047 C
00048 C
00049 C
00050 C           Elimination of sign.
00051 C
00052       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00053       IF (LHOOK) CALL DR_HOOK('CONFI',0,ZHOOK_HANDLE)
00054       LLPOSI=PFVAL.GE.0.0
00055       ZREF = ABS (PFVAL)
00056 C
00057 C
00058 C
00059 C
00060 C     EXPONENT
00061 C
00062       IF (ZREF.EQ.0.0) THEN
00063         KEXP = 0
00064       ELSE
00065         IEXP = INT ( ( LOG(ZREF)/LOG(16.0) + 65. ) +ZEPS )
00066         KEXP= MAX (0, MIN (127,IEXP))
00067       ENDIF
00068 C
00069 C
00070 C
00071 C
00072 C
00073 C
00074 C     MANTISSA
00075 C
00076   201 CONTINUE
00077 C
00078       ZMANT = ZREF/(ZC16**(KEXP-70))
00079 C
00080       IF (LLPOSI) THEN
00081         KMANT=INT (ZMANT)
00082       ELSE
00083 C
00084 C        Special case for negative values... because the "INT" function
00085 C     is not equivalent to the "integer part" mathematical function
00086 C     for this range of values.
00087 C
00088         IAUXIL=2+INT (ZMANT)
00089         KMANT=IAUXIL - INT ( -ZMANT + REAL (IAUXIL,JPDBLR) )
00090       ENDIF
00091 C
00092       IF (KMANT.GE.2**24) THEN
00093 C
00094         IF (KEXP.LT.127) THEN
00095 C
00096 C     Some rounding error ocurred in the computation of KEXP, and could
00097 C     not be compensated by ZEPS. Incrementation of KEXP, and new value
00098 C     of KMANT computed.
00099 C
00100           KEXP=KEXP+1
00101           GOTO 201
00102         ELSE
00103           PRINT *,
00104      S'*/*/* OVERFLOW OF GRIB FLOATING-POINT REPRESENTATION WITH ',PFVAL
00105           KMANT=2**24-1
00106         ENDIF
00107 C
00108       ENDIF
00109 C
00110 C     COMPUTE "EXACT" VALUE REPRESENTED, AND ADD SIGN BIT TO EXPONENT.
00111 C
00112       IF (LLPOSI) THEN
00113         PNFVAL =  KMANT*(ZC16**(KEXP-70))
00114       ELSE
00115         PNFVAL = -KMANT*(ZC16**(KEXP-70))
00116         KEXP=KEXP+128
00117       ENDIF
00118 C
00119 C
00120       IF (LHOOK) CALL DR_HOOK('CONFI',1,ZHOOK_HANDLE)
00121       END