NOAA KLM User's Guide
Appendix N
|
Introduction Page,
NOAA KLM TOC,
Acronyms
Previous Section,
Next Section
APPENDIX N: Software for Converting IBM Floating Point Numbers to IEEE Real Numbers
This appendix contains FORTRAN software that will convert IBM Floating Point numbers to IEEE real numbers. This software can be
used to convert SST data.
FUNCTION R4CONV(R4IBM)
C
C *********************************************************************
C
C NAME- R4CONV
C
C LANGUAGE- MICROSOFT FORTRAN TYPE- FUNCTION COMPUTER- PC
C
C VERSION- 1.0 DATE- 08/14/91 PROGRAMMER- KARL COX
C
C DESCRIPTION- THIS FUNCTION CONVERTS THE INPUT IBM VS FORTRAN
C INTERNAL REPRESENTATION FOR R*4 INTO AN IEEE R*4
C INTERNAL REPRESENTATION FOR USE WITH THE RS/6000.
C
C VS FORTRAN R*4 INTERNAL REPRESENTATION
C
C |-|-------|------------------------|
C |S| CHAR | FRACTION |
C |-|-------|------------------------|
C 0 1.....7 8......................31
C
C 1) THE CHARACTERISTIC IS IN BASE 16, AND AN
C OFFSET OF 64 IS USED. I.E., 16**(CHAR - 64)
C
C 2) THE DECIMAL VALUE IS OBTAINED BY DIVIDING
C THE FRACTION BY 2**24, AND MULTIPLYING BY
C THE DECIMAL NUMBER REPRESENTED BY THE
C CHARACTERISTIC.
C
C IEEE R*4 INTERNAL REPRESENTATION
C
C |-|--------|-----------------------|
C |S| CHAR | FRACTION |
C |-|--------|-----------------------|
C 0 1......8 9......................31
C
C 1) THE CHARACTERISTIC IS IN BASE 2, AND AN
C OFFSET OF 127 IS USED.
C I.E., 2**(CHAR - 127)
C
C 2) THE DECIMAL VALUE IS OBTAINED BY DIVIDING
C THE FRACTION BY 2**23, ADDING 1.0, AND
C MULTIPLYING BY THE DECIMAL NUMBER
C REPRESENTED BY THE CHARACTERISTIC.
C CALLING PARAMETERS-
C
C VARIABLE TYPE I/O DESCRIPTION
C -------- ---- --- ----------------------------------------
C R4IBM R*4 I THE VALUE THAT IS TO BE CONVERTED.
C
C LOCAL VARIABLES-
C
C VARIABLE TYPE DESCRIPTION
C --------------- -------- ------------------------------------
C VALUE R*4 HOLDS THE VALUE TO BE CONVERTED FOR
C EQUIVALENCING PURPOSES.
C
C IVALUE I*4 HOLDS THE INTEGER REPRESENTATION OF
C THE VALUE TO BE CONVERTED VIA AN
C EQUIVALENCE.
C
C SIGN I*4 HOLDS THE SIGN OF THE VALUE.
C
C CHARAC I*4 HOLDS THE CHARACTERISTIC OF THE VALUE
C
C FRACT I*4 HOLDS THE FRACTION OF THE VALUE.
C
C MAXFRA I*4 MAXIMUM FRACTION VALUE.
C
C NEGSIG I*4 NEGATIVE SIGN VALUE.
C
C POSSIG I*4 POSITIVE SIGN VALUE.
C
C IMASK1 I*4 MASK OF ONES.
C
C IMASK2 I*4 MASK OF ZEROS.
C
C R8MXFR R*8 DOUBLE PRECISION MAXIMUM FRACTION.
C
C MASKCH I*4 MASK FOR THE CHARACTERISTIC PORTION.
C
C MASKFR I*4 MASK FOR THE FRACTIONAL PORTION.
C
C R4SPV R*4 REAL*4 SPECIAL VALUE.
C
C AR4SPV I*4 EQUIVALENCED TO R4SPV.
C
C FUNCTIONS USED- BTEST, DBLE, IAND, IOR, ISHFT
C
C EXIT STATES- NONE
C
C**********************************************************************
C
REAL*4 R4IBM
REAL*4 R4CONV
C
REAL*4 VALUE
INTEGER*4 IVALUE
EQUIVALENCE (VALUE,IVALUE)
INTEGER*4 SIGN, CHARAC, FRACT
C
C PARAMETER DECLARATIONS.
C
INTEGER*4 MAXFRA, NEGSIG, POSSIG, IMASK1, IMASK2
REAL*8 R8MXFR
INTEGER*4 MASKCH,MASKFR
C
C REAL*4 SPECIAL VALUE.
C
REAL*4 R4SPV
INTEGER*4 AR4SPV
EQUIVALENCE (R4SPV,AR4SPV)
DATA AR4SPV /Z80000001/
DATA MAXFRA / Z01000000/, NEGSIG / Z80000000/,
1 POSSIG / Z00000000/, IMASK1 / Z7F7FFFFF/,
2 IMASK2 / Z00800000/
DATA MASKCH /Z7F000000/,MASKFR /Z00FFFFFF/
R8MXFR = MAXFRA
C
C TEST IF SPECIAL VALUE.
C
IF(R4IBM .EQ. R4SPV) THEN
R4CONV = R4SPV
ELSE
C
C NOT SPECIAL VALUE, GET SIGN AND CHARACTERISTIC.
C
VALUE = R4IBM
IF(BTEST(IVALUE,31)) THEN
SIGN = NEGSIG
ELSE
SIGN = POSSIG
ENDIF
CHARAC = IAND(IVALUE,MASKCH)
C
C RIGHT JUSTIFY CHARAC, REMOVE BIAS
C AND CONVERT FROM BASE 16 TO BASE 2.
C
CHARAC = ( ISHFT(CHARAC, -24) - 64)*4
C
C IF VS FORTRAN CHARAC IS GREATER THAN THE
C LARGEST IEEE CHARAC VALUE OR LESS THAN
C THE SMALLEST IEEE CHARACTERISTIC VALUE, RETURN
C THE CORRESPONDING EXTREME IEEE VALUE.
C
IF(CHARAC .GT. 127) THEN
IVALUE = IOR(SIGN,IMASK1)
R4CONV = VALUE
ELSE IF(CHARAC .LT. -126) THEN
IVALUE = IOR(SIGN,IMASK2)
R4CONV = VALUE
ELSE
C
C EXTRACT BINARY FRACT AND COMPUTE IEEE VALUE.
C
FRACT = IAND(IVALUE,MASKFR)
VALUE = (2.0**CHARAC) * (DBLE(FRACT)/R8MXFR)
IVALUE = IOR(SIGN,IVALUE)
R4CONV = VALUE
ENDIF
ENDIF
C
RETURN
END