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

Go to the documentation of this file.
00001       SUBROUTINE CONFP_MF (PFVAL,KEXP,KMANT)
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      : CONFP
00012 C*
00013 C*    FUNCTION  : CONVERT FLOATING POINT NUMBER FROM MACHINE
00014 C*                REPRESENTATION TO GRIB REPRESENTATION.
00015 C*
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*
00022 C*    JOHN HENNESSY , ECMWF , 15TH APRIL 1985
00023 C*
00024 C*    Modified by Jean CLOCHARD, February 1990, to comply with "DOCTOR",
00025 C*    and to get a better precision on the truncation made:
00026 C*       according to FM92 GRIB specification and recommandation,
00027 C*    replacement of "1.0/ALOG(2.0)" by "1.+ZEPS", where ZEPS
00028 C*    is a small positive value avoiding rounding errors to lead to
00029 C*    a mantissa greater than (or equal to) 2**24.
00030 C*
00031 C*    (recommandation: ZEPS=1.E-12 for machines with word length of 60
00032 C*                     bits or more, ZEPS=1.E-8 for 32 bits word length)
00033 C*
00034 C*       Tested with 10**5 pseudo-random values through the RANF
00035 C*    function on Cyber 960 under NOS/VE 1.4.2, the modification gives
00036 C*    an enhancement of more than 10, both on standard deviation and
00037 C*    maximum error. Similar results are obtained when changing test
00038 C*    interval from (0,1) to (-256,256).
00039 C*
00040 C*    Overflowing values are truncated, with a message on the listing.
00041 C*
00042 C********************************************************************
00043 C
00044 #include "precision.h"
00045 C
00046       INTEGER KEXP, KMANT
00047 C
00048       REAL (KIND=JPDBLR) PFVAL
00049 C
00050       INTEGER IEXP
00051 C
00052       REAL (KIND=JPDBLR) ZEPS, ZREF, ZC16
00053 C
00054       INTRINSIC ABS, LOG, MAX, MIN
00055 C
00056       SAVE ZEPS, ZC16
00057       DATA ZEPS / 1.E-12 /
00058       DATA ZC16 / 16. /
00059 C
00060 C
00061 C
00062 C           Elimination of sign.
00063 C
00064 C
00065       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00066       IF (LHOOK) CALL DR_HOOK('CONFP_MF',0,ZHOOK_HANDLE)
00067       ZREF = ABS (PFVAL)
00068 C
00069 C
00070 C
00071 C     EXPONENT
00072 C
00073       IF (ZREF.EQ.0.0) THEN
00074         KEXP = 0
00075       ELSE
00076         IEXP = INT ( ( LOG(ZREF)/LOG(ZC16) + 65. ) +ZEPS )
00077         KEXP= MAX (0, MIN (127,IEXP))
00078       ENDIF
00079 C
00080 C
00081 C
00082 C
00083 C
00084 C
00085 C
00086 C     MANTISSA
00087 C
00088   201 CONTINUE
00089 C
00090       KMANT = NINT ( ZREF/(ZC16**(KEXP-70)) )
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     ADD SIGN BIT TO EXPONENT.
00111 C
00112       IF (PFVAL.LT.0.0) KEXP = KEXP + 128
00113 C
00114 C
00115 C
00116 C
00117       IF (LHOOK) CALL DR_HOOK('CONFP_MF',1,ZHOOK_HANDLE)
00118       END