ungrib/src/ngl/g2/rdieee.f

   1       subroutine rdieee(rieee,a,num)
   2 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 !                .      .    .                                       .
   4 ! SUBPROGRAM:    rdieee
   5 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-09
   6 !
   7 ! ABSTRACT: This subroutine reads a list of real values in
   8 !   32-bit IEEE floating point format.
   9 !
  10 ! PROGRAM HISTORY LOG:
  11 ! 2000-05-09  Gilbert
  12 !
  13 ! USAGE:    CALL rdieee(rieee,a,num)
  14 !   INPUT ARGUMENT LIST:
  15 !     rieee    - Input array of floating point values in 32-bit IEEE format.
  16 !     num      - Number of floating point values to convert.
  17 !
  18 !   OUTPUT ARGUMENT LIST:
  19 !     a        - Output array of real values.
  20 !
  21 ! REMARKS: None
  22 !
  23 ! ATTRIBUTES:
  24 !   LANGUAGE: Fortran 90
  25 !   MACHINE:  IBM SP
  26 !
  27 !$$$
  28
  29       real(4),intent(in) :: rieee(num)
  30       real,intent(out) :: a(num)
  31       integer,intent(in) :: num
  32
  33       integer(4) :: ieee
  34
  35 ! Recent versions of the PGI compilers apparently still do not fully support
  36 ! the use of all intrinsics in parameter statements, though this is part of
  37 ! the F2003 standard.
  38 !      real, parameter :: two23=scale(1.0,23)
  39 !      real, parameter :: two126=scale(1.0,126)
  40       real :: two23
  41       real :: two126
  42
  43       two23=scale(1.0,-23)
  44       two126=scale(1.0,-126)
  45
  46       do j=1,num
  47 !
  48 !  Transfer IEEE bit string to integer variable
  49 !
  50         ieee=transfer(rieee(j),ieee)
  51 !
  52 !  Extract sign bit, exponent, and mantissa
  53 !
  54         isign=ibits(ieee,31,1)
  55         iexp=ibits(ieee,23,8)
  56         imant=ibits(ieee,0,23)
  57         sign=1.0
  58         if (isign.eq.1) sign=-1.0
  59
  60         if ( (iexp.gt.0).and.(iexp.lt.255) ) then
  61           temp=2.0**(iexp-127)
  62           a(j)=sign*temp*(1.0+(two23*real(imant)))
  63
  64         elseif ( iexp.eq.0 ) then
  65           if ( imant.ne.0 ) then
  66             a(j)=sign*two126*two23*real(imant)
  67           else
  68             a(j)=sign*0.0
  69           endif
  70
  71         elseif ( iexp.eq.255 ) then
  72           a(j)=sign*huge(a(j))
  73
  74         endif
  75
  76       enddo
  77
  78       return
  79       end
  80