missing.F90

Go to the documentation of this file.

 
 
integer function ibfms ( r8val ) result ( iret )
 
  use modv_vars, only: bmiss
 
  implicit none
 
  real*8, intent(in) :: r8val
 
  if ( r8val == bmiss ) then
    iret = 1
  else
    iret = 0
  endif
 
  return
end function ibfms
 
recursive integer function icbfms ( str, lstr ) result ( iret )
 
  use modv_vars, only: im8b
 
  implicit none
 
  character*(*), intent(in) :: str
  character*8 strz
  character*16 zz
  character*16, parameter :: zm_be = '202020E076483742'   ! 10E10 stored as hexadecimal on a big-endian system
  character*16, parameter :: zm_le = '42374876E8000000'   ! 10E10 stored as hexadecimal on a little-endian system
 
  real*8 rl8z
 
  integer, intent(in) :: lstr
  integer my_lstr, numchr, ii, iupm
  integer*8 il8z
 
  equivalence(strz,rl8z)
 
  ! Check for I8 integers.
 
  if ( im8b ) then
    im8b = .false.
 
    call x84 ( lstr, my_lstr, 1 )
    iret = icbfms( str, my_lstr )
 
    im8b = .true.
    return
  end if
 
  iret = 0
 
  numchr = min(lstr,len(str))
 
  ! Beginning with version 10.2.0 of the NCEPLIBS-bufr, all "missing" strings have been explicitly encoded with all bits set
  ! to 1, and which is the correct encoding per WMO regulations.  However, prior to version 10.2.0, the library encoded a
  ! "missing" string by storing the real*8 value of 10E10 into the string.  So for consistency with historical archives,
  ! the following logic attempts to identify some of these earlier cases, at least for strings between 4 and 8 bytes in length.
 
  if ( numchr>=4 .and. numchr<=8 ) then
    do ii = 1, numchr
      strz(ii:ii) = str(ii:ii)
    end do
    write (zz,'(z16.16)') transfer(rl8z,il8z)
    ii = 2*(8-numchr)+1
    if ( zz(ii:16)==zm_be(ii:16) .or. zz(ii:16)==zm_le(ii:16) ) then
      iret = 1
      return
    end if
  end if
 
  ! Otherwise, the logic below will check for "missing" strings of any length which are correctly encoded with all bits set
  ! to 1, including those encoded by NCEPLIBS-bufr version 10.2.0 or later.
 
  do ii=1,numchr
    strz(1:1) = str(ii:ii)
    if ( iupm(strz(1:1),8)/=255 ) return
  enddo
 
  iret = 1
 
  return
end function icbfms
 
real*8 function getbmiss() result(r8val)
 
  use modv_vars, only: bmiss
 
  implicit none
 
  r8val = bmiss
 
  return
end function getbmiss
 
subroutine setbmiss(xmiss)
 
  use modv_vars, only: bmiss
 
  implicit none
 
  real*8, intent(in) :: xmiss
 
  bmiss = xmiss
 
  return
end subroutine setbmiss