g2getgb2.F90

Go to the documentation of this file.

 
 
subroutine getgb2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt,  &
     unpack, k, gfld, iret)
  use grib_mod
  implicit none
 
  integer, intent(in) :: lugb, lugi, j, jdisc
  integer, dimension(:) :: jids(*)
  integer, intent(in) :: jpdtn
  integer, dimension(:) :: jpdt(*)
  integer, intent(in) :: jgdtn
  integer, dimension(:) :: jgdt(*)
  logical, intent(in) :: unpack
  integer, intent(out) :: k
  type(gribfield), intent(out) :: gfld
  integer, intent(out) ::iret
  integer :: idxver = 1
 
  call getgb2i2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt,  &
       unpack, idxver, k, gfld, iret)
end subroutine getgb2
 
subroutine getgb2i2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt,  &
     unpack, idxver, k, gfld, iret)
  use g2logging
  use grib_mod
  implicit none
 
  integer, intent(in) :: lugb, lugi, j, jdisc
  integer, dimension(:) :: jids(*)
  integer, intent(in) :: jpdtn
  integer, dimension(:) :: jpdt(*)
  integer, intent(in) :: jgdtn
  integer, dimension(:) :: jgdt(*)
  logical, intent(in) :: unpack
  integer, intent(in) :: idxver
  integer, intent(out) :: k
  type(gribfield), intent(out) :: gfld
  integer, intent(out) ::iret
  character(len = 1), pointer, dimension(:) :: cbuf
  integer :: nnum, nlen, lpos, jk, irgi, irgs
 
  ! Declare interfaces (required for cbuf pointer).
  interface
     subroutine getidx2(lugb, lugi, idxver, cindex, nlen, nnum, iret)
       integer, intent(in) :: lugb, lugi, idxver
       character(len = 1), pointer, dimension(:) :: cindex
       integer, intent(out) :: nlen, nnum, iret
     end subroutine getidx2
     subroutine getgb2s2(cbuf, idxver, nlen, nnum, j, jdisc, jids, jpdtn, jpdt, jgdtn, &
          jgdt, k, gfld, lpos, iret)
       import gribfield
       character(len = 1), intent(in) :: cbuf(nlen)
       integer, intent(in) :: idxver, nlen, nnum, j, jdisc
       integer, dimension(:) :: jids(*)
       integer, intent(in) :: jpdtn
       integer, dimension(:) :: jpdt(*)
       integer, intent(in) :: jgdtn
       integer, dimension(:) :: jgdt(*)
       integer, intent(out) :: k
       type(gribfield), intent(out) :: gfld
       integer, intent(out) :: lpos, iret
     end subroutine getgb2s2
     subroutine getgb2l2(lugb, idxver, cindex, gfld, iret)
       use grib_mod
       integer, intent(in) :: lugb, idxver
       character(len = 1), intent(in) :: cindex(*)
       type(gribfield) :: gfld
       integer, intent(out) :: iret
     end subroutine getgb2l2
     subroutine getgb2r2(lugb, idxver, cindex, gfld, iret)
       use grib_mod
       implicit none
       integer, intent(in) :: lugb, idxver
       character(len=1), intent(in) :: cindex(*)
       type(gribfield) :: gfld
       integer, intent(out) :: iret
     end subroutine getgb2r2
  end interface
 
#ifdef LOGGING
  write(g2_log_msg, '(a, i2, a, i2, a, i5, a, i5, a, l, a, i1)') 'getgb2i2: lugb ', lugb, ' lugi ', lugi, &
       ' j ', j, ' jdisc ', jdisc, ' unpack ', unpack, ' idxver ', idxver
  call g2_log(1)
#endif
  
  ! Fill cbuf with the index records of this file, by recalling them
  ! from memory, reading them from the index file, or generating them
  ! from the data file.
  irgi = 0
  call getidx2(lugb, lugi, idxver, cbuf, nlen, nnum, irgi)
  if (irgi .gt. 1) then
     iret = 96
     return
  endif
 
  ! Search the index in cbuf for the first message which meets our
  ! search criteria.
  call getgb2s2(cbuf, idxver, nlen, nnum, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt,  jk, &
       gfld, lpos, irgs)
  if (irgs .ne. 0) then
     iret = 99
     call gf_free(gfld)
     return
  endif
 
  ! Read local use section for the selected GRIB2 message, if available.
  call getgb2l2(lugb, idxver, cbuf(lpos), gfld, iret)
 
  ! Read and unpack grib record for the selected GRIB2 message.
  if (unpack) then
     call getgb2r2(lugb, idxver, cbuf(lpos), gfld, iret)
  endif
 
  ! Return the number of the unpacked field to the caller.
  k = jk
end subroutine getgb2i2
 
subroutine getgb2l(lugb, cindex, gfld, iret)
  use grib_mod
  implicit none
 
  integer, intent(in) :: lugb
  character(len = 1), intent(in) :: cindex(*)
  type(gribfield) :: gfld
  integer, intent(out) :: iret
 
  interface
     subroutine getgb2l2(lugb, idxver, cindex, gfld, iret)
       use grib_mod
       integer, intent(in) :: lugb, idxver
       character(len = 1), intent(in) :: cindex(*)
       type(gribfield) :: gfld
       integer, intent(out) :: iret
     end subroutine getgb2l2
  end interface
 
  call getgb2l2(lugb, 1, cindex, gfld, iret)
 
end subroutine getgb2l
  
subroutine getgb2l2(lugb, idxver, cindex, gfld, iret)
  use g2logging
  use grib_mod
  implicit none
 
  integer, intent(in) :: lugb, idxver
  character(len = 1), intent(in) :: cindex(*)
  type(gribfield) :: gfld
  integer, intent(out) :: iret
 
  integer :: lskip, skip2
  integer (kind = 8) :: lskip8, iskip8, lread8, ilen8, skip28
  character(len = 1):: csize(4)
  character(len = 1), allocatable :: ctemp(:)
  integer :: ilen, iofst, ierr
  integer :: INT1_BITS, INT2_BITS, INT4_BITS, INT8_BITS
  parameter(int1_bits = 8, int2_bits = 16, int4_bits = 32, int8_bits = 64)
  integer :: mypos
 
  interface
     subroutine g2_gbytec1(in, siout, iskip, nbits)
       character*1, intent(in) :: in(*)
       integer, intent(inout) :: siout
       integer, intent(in) :: iskip, nbits
     end subroutine g2_gbytec1
     subroutine g2_gbytec81(in, siout, iskip, nbits)
       character*1, intent(in) :: in(*)
       integer (kind = 8), intent(inout) :: siout
       integer, intent(in) :: iskip, nbits
       integer (kind = 8) :: iout(1)
     end subroutine g2_gbytec81
     subroutine gf_unpack2(cgrib, lcgrib, iofst, lencsec2, csec2, ierr)
       character(len = 1), intent(in) :: cgrib(lcgrib)
       integer, intent(in) :: lcgrib
       integer, intent(inout) :: iofst
       integer, intent(out) :: lencsec2
       integer, intent(out) :: ierr
       character(len = 1), pointer, dimension(:) :: csec2
     end subroutine gf_unpack2
  end interface
 
 
#ifdef LOGGING
  write(g2_log_msg, '(a, i2, a, i1)') 'getgb2l2: lugb ', lugb, ' idxver ', idxver
  call g2_log(1)
#endif
  
  ! Get info.
  nullify(gfld%local)
  iret = 0
  mypos = int4_bits ! Skip length of index record.
 
  ! These are all 4-byte ints in index format 1, and 8-byte ints in
  ! index version 2.
  if (idxver .eq. 1) then
     ! Read bytes to skip in file before message.
     call g2_gbytec1(cindex, lskip, mypos, int4_bits)
     mypos = mypos + int4_bits
     lskip8 = lskip
     ! Read bytes to skip in msg before local use.
     call g2_gbytec1(cindex, skip2, mypos, int4_bits)
     skip28 = skip2
  else
     ! Read bytes to skip in file before message.
     call g2_gbytec81(cindex, lskip8, mypos, int8_bits)
     mypos = mypos + int8_bits
     ! Read bytes to skip in msg before local use.
     call g2_gbytec81(cindex, skip28, mypos, int8_bits)
     mypos = mypos + int8_bits
  endif
 
  ! Read and unpack local use section, if present.
  if (skip28 .ne. 0) then
     iskip8 = lskip8 + skip28
 
     ! Get length of section.
     call bareadl(lugb, iskip8, 4_8, lread8, csize)    
     call g2_gbytec1(csize, ilen, 0, 32)
     allocate(ctemp(ilen))
     ilen8 = ilen
 
     ! Read in section.
     call bareadl(lugb, iskip8, ilen8, lread8, ctemp)  
     if (ilen8 .ne. lread8) then
        iret = 97
        deallocate(ctemp)
        return
     endif
     iofst = 0
     call gf_unpack2(ctemp, ilen, iofst, gfld%locallen, gfld%local, ierr)
     if (ierr .ne. 0) then
        iret = 98
        deallocate(ctemp)
        return
     endif
     deallocate(ctemp)
  else
     gfld%locallen = 0
  endif
end subroutine getgb2l2
 
subroutine getgb2p(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt,  &
     extract, k, gribm, leng, iret)
  use grib_mod
  implicit none
 
  integer, intent(in) :: lugb, lugi, j, jdisc
  integer, dimension(:) :: jids(*)
  integer, intent(in) :: jpdtn
  integer, dimension(:) :: jpdt(*)
  integer, intent(in) :: jgdtn
  integer, dimension(:) :: jgdt(*)
  logical, intent(in) :: extract
  integer, intent(out) :: k
  character(len = 1), pointer, dimension(:) :: gribm
  integer, intent(out) :: leng, iret
  integer :: idxver
 
  integer (kind = 8) :: leng8
 
  interface
     subroutine getgb2p2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt,  &
          extract, idxver, k, gribm, leng8, iret)
       integer, intent(in) :: lugb, lugi, j, jdisc
       integer, dimension(:) :: jids(*)
       integer, intent(in) :: jpdtn
       integer, dimension(:) :: jpdt(*)
       integer, intent(in) :: jgdtn
       integer, dimension(:) :: jgdt(*)
       logical, intent(in) :: extract
       integer, intent(inout) :: idxver
       integer, intent(out) :: k
       character(len = 1), pointer, dimension(:) :: gribm
       integer (kind = 8), intent(out) :: leng8
       integer, intent(out) :: iret
     end subroutine getgb2p2
  end interface
 
  ! Call the new version of this subroutine, which handles messages > 2 GB.
  idxver = 1
  call getgb2p2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt,  &
       extract, idxver, k, gribm, leng8, iret)
  leng = int(leng8, kind(4))
 
end subroutine getgb2p
 
subroutine getgb2p2(lugb, lugi, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt,  &
     extract, idxver, k, gribm, leng8, iret)
  use grib_mod
  implicit none
 
  integer, intent(in) :: lugb, lugi, j, jdisc
  integer, dimension(:) :: jids(*)
  integer, intent(in) :: jpdtn
  integer, dimension(:) :: jpdt(*)
  integer, intent(in) :: jgdtn
  integer, dimension(:) :: jgdt(*)
  logical, intent(in) :: extract
  integer, intent(inout) :: idxver
  integer, intent(out) :: k
  character(len = 1), pointer, dimension(:) :: gribm
  integer (kind = 8), intent(out) :: leng8
  integer, intent(out) :: iret
 
  type(gribfield) :: gfld
  integer :: irgi, irgs, jk, lpos, mskp, nlen, nmess, nnum
  character(len = 1), pointer, dimension(:) :: cbuf
  integer (kind = 8) :: msk1, msk2
  parameter(msk1 = 32000, msk2 = 4000)
 
  interface
     subroutine getg2i(lugi, cbuf, nlen, nnum, iret)
       character(len = 1), pointer, dimension(:) :: cbuf
       integer, intent(in) :: lugi
       integer, intent(out) :: nlen, nnum, iret
     end subroutine getg2i
     subroutine getg2ir(lugb, msk1, msk2, mnum, cbuf, nlen, nnum,  &
          nmess, iret)
       character(len = 1), pointer, dimension(:) :: cbuf
       integer, intent(in) :: lugb, msk1, msk2, mnum
       integer, intent(out) :: nlen, nnum, nmess, iret
     end subroutine getg2ir
     subroutine getg2i2(lugi, cbuf, idxver, nlen, nnum, iret)
       integer, intent(in) :: lugi
       character(len=1), pointer, dimension(:) :: cbuf
       integer, intent(out) :: idxver, nlen, nnum, iret
     end subroutine getg2i2
     subroutine getg2i2r(lugb, msk1, msk2, mnum, idxver, cbuf, &
          nlen, nnum, nmess, iret)
       integer, intent(in) :: lugb
       integer (kind = 8), intent(in) :: msk1, msk2
       integer, intent(in) :: mnum, idxver
       character(len = 1), pointer, dimension(:) :: cbuf
       integer, intent(out) :: nlen, nnum, nmess, iret
     end subroutine getg2i2r
     subroutine getgb2rp2(lugb, idxver, cindex, extract, gribm, leng8, iret)
       integer, intent(in) :: lugb
       integer, intent(inout) :: idxver
       character(len = 1), intent(in) :: cindex(*)
       logical, intent(in) :: extract
       character(len = 1), pointer, dimension(:) :: gribm
       integer (kind = 8), intent(out) :: leng8
       integer, intent(out) :: iret
     end subroutine getgb2rp2
     subroutine getgb2s2(cbuf, idxver, nlen, nnum, j, jdisc, jids, jpdtn, jpdt, jgdtn, &
          jgdt, k, gfld, lpos, iret)
       import gribfield
       character(len = 1), intent(in) :: cbuf(nlen)
       integer, intent(in) :: idxver, nlen, nnum, j, jdisc
       integer, dimension(:) :: jids(*)
       integer, intent(in) :: jpdtn
       integer, dimension(:) :: jpdt(*)
       integer, intent(in) :: jgdtn
       integer, dimension(:) :: jgdt(*)
       integer, intent(out) :: k
       type(gribfield), intent(out) :: gfld
       integer, intent(out) :: lpos, iret
     end subroutine getgb2s2
  end interface
 
  nullify(gribm)
 
  ! Initialize the index information in cbuf.
  irgi = 0
  if (lugi .gt. 0) then
     call getg2i2(lugi, cbuf, idxver, nlen, nnum, irgi)
  elseif (lugi .le. 0) then
     mskp = 0
     call getg2i2r(lugb, msk1, msk2, mskp, idxver, cbuf, nlen, nnum, nmess, irgi)
  endif
  if (irgi .gt. 1) then
     iret = 96
     return
  endif
 
  ! Find info from index and fill a grib_mod::gribfield variable.
  call getgb2s2(cbuf, idxver, nlen, nnum, j, jdisc, jids, jpdtn, jpdt, jgdtn, jgdt,  &
       jk, gfld, lpos, irgs)
  if (irgs .ne. 0) then
     iret = 99
     call gf_free(gfld)
     return
  endif
 
  ! Extract grib message from file.
  call getgb2rp2(lugb, idxver, cbuf(lpos:), extract, gribm, leng8, iret)
 
  k = jk
 
  ! Free cbuf memory allocated in getg2i/getg2ir().
  if (associated(cbuf)) deallocate(cbuf)
  
  call gf_free(gfld)
end subroutine getgb2p2
 
subroutine getgb2r(lugb, cindex, gfld, iret)
  use grib_mod
  implicit none
 
  integer, intent(in) :: lugb
  character(len=1), intent(in) :: cindex(*)
  type(gribfield) :: gfld
  integer, intent(out) :: iret
 
  interface
     subroutine getgb2r2(lugb, idxver, cindex, gfld, iret)
       use grib_mod
       implicit none
       integer, intent(in) :: lugb, idxver
       character(len=1), intent(in) :: cindex(*)
       type(gribfield) :: gfld
       integer, intent(out) :: iret
     end subroutine getgb2r2
  end interface
 
  call getgb2r2(lugb, 1, cindex, gfld, iret)
 
end subroutine getgb2r
 
subroutine getgb2r2(lugb, idxver, cindex, gfld, iret)
  use g2logging
  use grib_mod
  implicit none
 
  integer, intent(in) :: lugb, idxver
  character(len=1), intent(in) :: cindex(*)
  type(gribfield) :: gfld
  integer, intent(out) :: iret
 
  integer :: lskip, skip6, skip7
  integer (kind = 8) :: skip68, skip78
  character(len=1):: csize(4)
  character(len=1), allocatable :: ctemp(:)
  real, pointer, dimension(:) :: newfld
  integer :: n, j, iofst, ilen, ierr, idum
  integer (kind = 8) :: lskip8, lread8, ilen8, iskip8
  ! Bytes to skip in (version 1 and 2) index record to get to bms.    
  integer :: IXBMS1, IXBMS2
  parameter(ixbms1 = 24, ixbms2 = 44)
  ! Bytes to skip in (version 1 and 2) index record to get to data section.
  integer :: IXDS1, IXDS2
  parameter(ixds1 = 28, ixds2 = 52)
  integer :: INT1_BITS, INT2_BITS, INT4_BITS, INT8_BITS
  parameter(int1_bits = 8, int2_bits = 16, int4_bits = 32, int8_bits = 64)
 
  interface
     subroutine gf_unpack6(cgrib, lcgrib, iofst, ngpts, ibmap, bmap, ierr)
       character(len=1), intent(in) :: cgrib(lcgrib)
       integer, intent(in) :: lcgrib, ngpts
       integer, intent(inout) :: iofst
       integer, intent(out) :: ibmap
       integer, intent(out) :: ierr
       logical*1, pointer, dimension(:) :: bmap
     end subroutine gf_unpack6
     subroutine gf_unpack7(cgrib, lcgrib, iofst, igdsnum, igdstmpl, &
          idrsnum, idrstmpl, ndpts, fld, ierr)
       character(len=1), intent(in) :: cgrib(lcgrib)
       integer, intent(in) :: lcgrib, ndpts, idrsnum, igdsnum
       integer, intent(inout) :: iofst
       integer, pointer, dimension(:) :: idrstmpl, igdstmpl
       integer, intent(out) :: ierr
       real, pointer, dimension(:) :: fld
     end subroutine gf_unpack7
     subroutine g2_gbytec(in, iout, iskip, nbits)
       character*1, intent(in) :: in(*)
       integer, intent(inout) :: iout(*)
       integer, intent(in) :: iskip, nbits
     end subroutine g2_gbytec
     subroutine g2_gbytec1(in, siout, iskip, nbits)
       character*1, intent(in) :: in(*)
       integer, intent(inout) :: siout
       integer, intent(in) :: iskip, nbits
       integer (kind = 4) :: iout(1)
     end subroutine g2_gbytec1
     subroutine g2_gbytec81(in, siout, iskip, nbits)
       character*1, intent(in) :: in(*)
       integer (kind = 8), intent(inout) :: siout
       integer, intent(in) :: iskip, nbits
       integer (kind = 8) :: iout(1)
     end subroutine g2_gbytec81
  end interface
 
#ifdef LOGGING
  write(g2_log_msg, *) 'getgb2r2: lugb ', lugb, ' idxver ', idxver
  call g2_log(1)
#endif
  
  ! Initialize.
  nullify(gfld%bmap, gfld%fld)
  iret = 0
 
  ! Get the bytes to skip to reach the local use section. In index
  ! version 1 this is a 4-byte value, in index version 2 it is an
  ! 8-byte value. (To reach the local use offset in the index record,
  ! we skip the first 4 bytes, which is the length of the index
  ! record.)
  if (idxver .eq. 1) then
     call g2_gbytec1(cindex, lskip, int4_bits, int4_bits)
     lskip8 = lskip
  else
     call g2_gbytec81(cindex, lskip8, int4_bits, int8_bits)
     lskip = int(lskip8, kind(4))
  endif
 
  ! Read the offset to section 6, the BMS section.
  if (idxver .eq. 1) then
     call g2_gbytec1(cindex, skip6, ixbms1 * int1_bits, int4_bits)
     skip68 = skip6
  else
     call g2_gbytec81(cindex, skip68, ixbms2 * int1_bits, int8_bits)
  endif
 
#ifdef LOGGING
  write(g2_log_msg, *) ' getgb2r2: skip68', skip68
  call g2_log(1)
#endif
  
  ! Read the offset to section 7, the data section.
  if (idxver .eq. 1) then
     call g2_gbytec1(cindex, skip7, ixds1 * int1_bits, int4_bits)
  else
     call g2_gbytec81(cindex, skip78, ixds2 * int1_bits, int8_bits)
     skip7 = int(skip78, kind(4))
  endif
 
#ifdef LOGGING
  write(g2_log_msg, *) ' getgb2r2: skip7', skip7
  call g2_log(1)
#endif
  
  ! Read and unpack bit_map, if present.
  if (gfld%ibmap .eq. 0 .or. gfld%ibmap .eq. 254) then
     iskip8 = lskip8 + skip68
 
     ! Get length of bitmap section.
     call bareadl(lugb, iskip8, 4_8, lread8, csize)
     call g2_gbytec1(csize, ilen, 0, int4_bits)
     allocate(ctemp(ilen))
     ilen8 = ilen
     
     ! Read in bitmap section.
     call bareadl(lugb, iskip8, ilen8, lread8, ctemp)  
     if (ilen8 .ne. lread8) then
        iret = 97
        deallocate(ctemp)
        return
     endif
 
     ! Unpack bitmap section.
     iofst = 0
     call gf_unpack6(ctemp, ilen, iofst, gfld%ngrdpts, idum, gfld%bmap, ierr)
     if (ierr .ne. 0) then
        iret = 98
        deallocate(ctemp)
        return
     endif
     deallocate(ctemp)
  endif
 
  ! Read and unpack data field.
  iskip8 = lskip8 + skip7
  
  ! Get length of data section.
  call bareadl(lugb, iskip8, 4_8, lread8, csize)    
  call g2_gbytec1(csize, ilen, 0, int4_bits)
  if (ilen .lt. 6) ilen = 6
  allocate(ctemp(ilen))
  ilen8 = ilen
 
  ! Read in data section.
  call bareadl(lugb, iskip8, ilen8, lread8, ctemp)  
  if (ilen8 .ne. lread8) then
     iret = 97
     deallocate(ctemp)
     return
  endif
 
  ! Unpack data section.
  iofst = 0
  call gf_unpack7(ctemp, ilen, iofst, gfld%igdtnum, gfld%igdtmpl, &
       gfld%idrtnum, gfld%idrtmpl, gfld%ndpts, gfld%fld, ierr)
  if (ierr .ne. 0) then
     iret = 98
     deallocate(ctemp)
     return
  endif
  deallocate(ctemp)
 
  ! If bitmap is used with this field, expand data field
  ! to grid, if possible.
  if (gfld%ibmap .ne. 255 .AND. associated(gfld%bmap)) then
     allocate(newfld(gfld%ngrdpts))
     n = 1
     do j = 1, gfld%ngrdpts
        if (gfld%bmap(j)) then
           newfld(j) = gfld%fld(n)
           n = n+1
        else
           newfld(j) = 0.0
        endif
     enddo
     deallocate(gfld%fld);
     gfld%fld => newfld;
     gfld%expanded = .true.
  else
     gfld%expanded = .true.
  endif
end subroutine getgb2r2
 
subroutine getgb2rp(lugb, cindex, extract, gribm, leng, iret)
  implicit none
 
  integer, intent(in) :: lugb
  character(len = 1), intent(in) :: cindex(*)
  logical, intent(in) :: extract
  character(len = 1), pointer, dimension(:) :: gribm
  integer, intent(out) :: leng, iret
 
  integer (kind = 8) :: leng8
  integer :: idxver
 
  interface
     subroutine getgb2rp2(lugb, idxver, cindex, extract, gribm, leng8, iret)
       integer, intent(in) :: lugb
       integer, intent(inout) :: idxver
       character(len = 1), intent(in) :: cindex(*)
       logical, intent(in) :: extract
       character(len = 1), pointer, dimension(:) :: gribm
       integer (kind = 8), intent(out) :: leng8
       integer, intent(out) :: iret
     end subroutine getgb2rp2
  end interface
 
  ! Call the legacy version of this function. It will only work with
  ! GRIB messages < 2 GB.
  idxver = 1
  call getgb2rp2(lugb, idxver, cindex, extract, gribm, leng8, iret)
  leng = int(leng8, kind(4))
 
end subroutine getgb2rp
 
subroutine getgb2rp2(lugb, idxver, cindex, extract, gribm, leng8, iret)
  use g2logging
  implicit none
 
  integer, intent(in) :: lugb
  integer, intent(inout) :: idxver
  character(len = 1), intent(in) :: cindex(*)
  logical, intent(in) :: extract
  character(len = 1), pointer, dimension(:) :: gribm
  integer (kind = 8), intent(out) :: leng8
  integer, intent(out) :: iret
 
  integer, parameter :: zero = 0
  character(len = 1), allocatable, dimension(:) :: csec2, csec6, csec7
  character(len = 4) :: ctemp
  integer :: lencur, len0, ibmap = 0, ipos, iskip
  integer :: len7 = 0, len8 = 0, len3 = 0, len4 = 0, len5 = 0, len6 = 0, len1 = 0, len2 = 0
  integer :: iskp2, iskp6, iskp7
  integer (kind = 8) :: iskp2_8
  ! Bytes to skip in (version 1 and 2) index record to get to bms.    
  integer :: IXBMS1, IXBMS2
  parameter(ixbms1 = 24, ixbms2 = 44)
  ! Bytes to skip in (version 1 and 2) index record to get to data section.
  integer :: IXDS1, IXDS2
  parameter(ixds1 = 28, ixds2 = 52)
  integer :: INT1_BITS, INT2_BITS, INT4_BITS, INT8_BITS
  parameter(int1_bits = 8, int2_bits = 16, int4_bits = 32, int8_bits = 64)
  integer :: mypos, inc = 0
  integer (kind = 8) :: lread8, iskip8, len2_8, len7_8, len6_8, iskp68, iskp78
 
  interface
     subroutine g2_sbytec81(out, sin, iskip, nbits)
       character*1, intent(inout) :: out(*)
       integer (kind = 8), intent(in) :: sin
       integer, intent(in) :: iskip, nbits
     end subroutine g2_sbytec81
     subroutine g2_gbytec1(in, siout, iskip, nbits)
       character*1, intent(in) :: in(*)
       integer, intent(inout) :: siout
       integer, intent(in) :: iskip, nbits
     end subroutine g2_gbytec1
     subroutine g2_gbytec81(in, siout, iskip, nbits)
       character*1, intent(in) :: in(*)
       integer (kind = 8), intent(inout) :: siout
       integer, intent(in) :: iskip, nbits
     end subroutine g2_gbytec81
  end interface
 
#ifdef LOGGING
  write(g2_log_msg, *) 'getgb2rp2: lugb ', lugb, ' idxver ', idxver, ' extract ', extract
  call g2_log(1)
#endif
  
  iret = 0
 
  ! Extract grib message from file.
  mypos = int4_bits
  if (extract) then
     len0 = 16
     len8 = 4
     if (idxver .eq. 1) then
        call g2_gbytec1(cindex, iskip, mypos, int4_bits)    ! bytes to skip in file
        mypos = mypos + int4_bits
        iskip8 = iskip
        call g2_gbytec1(cindex, iskp2, mypos, int4_bits)    ! bytes to skip for section 2
        mypos = mypos + int4_bits
        iskp2_8 = iskp2
        mypos = mypos + 32 * int1_bits ! skip ahead in the cindex
     else
        inc = 28
        call g2_gbytec81(cindex, iskip8, mypos, int8_bits)    ! bytes to skip in file
        mypos = mypos + int8_bits
        call g2_gbytec81(cindex, iskp2_8, mypos, int8_bits)    ! bytes to skip for section 2
        mypos = mypos + int8_bits
 
        mypos = mypos + 52 * int1_bits ! skip ahead in the cindex
     endif
#ifdef LOGGING
     write(g2_log_msg, *) 'iskip8', iskip8, 'iskip', iskip, 'mypos/8', mypos/8
     call g2_log(2)
#endif
     
     ! Determine length of local section (section 2).
     if (iskp2_8 .gt. 0) then
        call bareadl(lugb, iskip8 + iskp2_8, 4_8, lread8, ctemp)
        call g2_gbytec1(ctemp, len2, 0, int4_bits)      ! length of section 2
        allocate(csec2(len2))
        len2_8 = len2
        call bareadl(lugb, iskip8 + iskp2_8, len2_8, lread8, csec2)
     else
        len2 = 0
     endif
#ifdef LOGGING
     write(g2_log_msg, *) 'iskip8 ', iskip8, ' iskp2_8 ', iskp2_8, 'len2', len2, 'mypos/8', mypos/8
     call g2_log(2)
#endif
 
     ! Find the lengths of the sections 1, 3, 4, 5, and 6.
     call g2_gbytec1(cindex, len1, mypos, int4_bits)      ! length of section 1
     mypos = mypos + len1 * int1_bits ! skip ahead in the cindex
     call g2_gbytec1(cindex, len3, mypos, int4_bits)      ! length of section 3
     mypos = mypos + len3 * int1_bits ! skip ahead in the cindex
     call g2_gbytec1(cindex, len4, mypos, int4_bits)      ! length of section 4
     mypos = mypos + len4 * int1_bits ! skip ahead in the cindex
     call g2_gbytec1(cindex, len5, mypos, int4_bits)      ! length of section 5
     mypos = mypos + len5 * int1_bits ! skip ahead in the cindex
     call g2_gbytec1(cindex, len6, mypos, int4_bits)      ! length of section 6
     mypos = mypos + len6 * int1_bits ! skip ahead in the cindex
#ifdef LOGGING
     write(g2_log_msg, *) 'len1', len1, 'len3', len3, 'len4', len4, 'len5', len5, 'len6', len6
     call g2_log(2)
#endif
 
     ! Handle the bitmap, if present.
     call g2_gbytec1(cindex, ibmap, mypos, int1_bits)      ! bitmap indicator
     if (ibmap .eq. 254) then
        ! Get the bytes to skip for section 6 from the index.
        if (idxver .eq. 1) then
           call g2_gbytec1(cindex, iskp6, ixbms1 * int1_bits, int4_bits)    
        else
           call g2_gbytec81(cindex, iskp68, ixbms2 * int1_bits, int8_bits)
           iskp6 = int(iskp68, kind(4))
        endif
#ifdef LOGGING
     write(g2_log_msg, *) 'getgb2rp2: iskp6', iskp6
     call g2_log(2)
#endif
 
        ! Read the length of the bitmap section from the data file. (lu, byts to
        ! skip, bytes to read, bytes read, buffer for output)
        call bareadl(lugb, iskip8 + iskp6, 4_8, lread8, ctemp)
        call g2_gbytec1(ctemp, len6, 0, int4_bits)      ! length of section 6
#ifdef LOGGING
        write(g2_log_msg, *) 'getgb2rp2: len6', len6
        call g2_log(2)
#endif
     endif
 
     !  Read the location of section 7 from the index.
     if (idxver .eq. 1) then
        call g2_gbytec1(cindex, iskp7, ixds1 * int1_bits, int4_bits)    ! bytes to skip for section 7
        iskp78 = iskp7
     else
        call g2_gbytec81(cindex, iskp78, ixds2 * int1_bits, int8_bits)    ! bytes to skip for section 7
     endif
#ifdef LOGGING
     write(g2_log_msg, *) 'getgb2rp2: iskp78', iskp78, 'IXDS2', ixds2
     call g2_log(2)
#endif
 
     ! Read in the length of section 7 from the data file.
     call bareadl(lugb, iskip8 + iskp78, 4_8, lread8, ctemp)
     call g2_gbytec1(ctemp, len7, 0, int4_bits)      ! length of section 7
 
     ! Now read in section 7.
     allocate(csec7(len7))
     len7_8 = len7
     call bareadl(lugb, iskip8 + iskp78, len7_8, lread8, csec7)
 
#ifdef LOGGING
     write(g2_log_msg, *) 'getgb2rp2: len0 ', len0, 'len1', len1, 'len2', len2 , 'len3', len3
     call g2_log(2)
     write(g2_log_msg, *) 'getgb2rp2: len4', len4, 'len5', len5, 'len5', len5, 'len6', len6, 'len7', len7, 'len8', len8
     call g2_log(2)
#endif
 
     ! Now we know the total length of the grib message.
     leng8 = len0 + len1 + len2 + len3 + len4 + len5 + len6 + len7 + len8
 
#ifdef LOGGING
  write(g2_log_msg, *) 'getgb2rp2: len7 ', len7, 'lread8', lread8, 'calculated leng8', leng8
  call g2_log(2)
#endif
 
     ! Allocate storage for the message.
     if (.not. associated(gribm)) allocate(gribm(leng8))
 
     ! Create Section 0
     gribm(1) = 'G'
     gribm(2) = 'R'
     gribm(3) = 'I'
     gribm(4) = 'B'
     gribm(5) = char(0)
     gribm(6) = char(0)
     gribm(7) = cindex(42 + inc) ! discipline
     gribm(8) = cindex(41 + inc) ! GRIB version
     call g2_sbytec81(gribm, leng8, int8_bits, int8_bits)
 
#ifdef LOGGING
     write(g2_log_msg, *) 'getgb2rp2: gribm(7) (discipline)', ichar(gribm(7)), &
          'gibm(8) (GRIB version)', ichar(gribm(8))
     call g2_log(2)
#endif
     
     ! Copy Section 1 from the index to the message.
     gribm(17:16 + len1) = cindex(45 + inc:44 + inc + len1)
     lencur = 16 + len1
     ipos = 44 + inc + len1
 
     ! Copy Section 2, if necessary.
     if (iskp2_8 .gt. 0) then
        gribm(lencur + 1:lencur + len2) = csec2(1:len2)
        lencur = lencur + len2
     endif
 
#ifdef LOGGING
     write(g2_log_msg, *) 'getgb2rp2: copied 1, 2'
     call g2_log(3)
#endif
     
     ! Copy Sections 3 through 5 from the index to the message.
     gribm(lencur + 1:lencur + len3 + len4 + len5) = cindex(ipos + 1:ipos + len3 + len4 + len5)
     lencur = lencur + len3 + len4 + len5
     ipos = ipos + len3 + len4 + len5
 
#ifdef LOGGING
     write(g2_log_msg, *) 'getgb2rp2: copied 3, 4, 5'
     call g2_log(3)
#endif
 
     ! Copy Section 6 from the index to the message.
     if (len6 .eq. 6 .and. ibmap .ne. 254) then
        gribm(lencur + 1:lencur + len6) = cindex(ipos + 1:ipos + len6)
        lencur = lencur + len6
     else
        if (idxver .eq. 1) then
           call g2_gbytec1(cindex, iskp6, ixbms1 * int1_bits, int4_bits)    ! bytes to skip for section 6
           iskp68 = iskp6
        else
           call g2_gbytec81(cindex, iskp68, ixbms2 * int1_bits, int8_bits)    ! bytes to skip for section 6
        endif
#ifdef LOGGING
        write(g2_log_msg, *) 'getgb2rp2: iskp68', iskp68
        call g2_log(3)
#endif
        call bareadl(lugb, iskip8 + iskp68, 4_8, lread8, ctemp)
        call g2_gbytec1(ctemp, len6, 0, int4_bits)      ! length of section 6
#ifdef LOGGING
        write(g2_log_msg, *) 'getgb2rp2: len6', len6
        call g2_log(3)
#endif
        allocate(csec6(len6))
        len6_8 = len6
        call bareadl(lugb, iskip8 + iskp68, len6_8, lread8, csec6)
        gribm(lencur + 1:lencur + len6) = csec6(1:len6)
        lencur = lencur + len6
        if (allocated(csec6)) deallocate(csec6)
     endif
 
#ifdef LOGGING
     write(g2_log_msg, *) 'getgb2rp2: copied  6, len7', len7
     call g2_log(3)
#endif
     
     ! Copy Section 7 to the message.
     gribm(lencur + 1:lencur + len7) = csec7(1:len7)
     lencur = lencur + len7
 
#ifdef LOGGING
     write(g2_log_msg, *) 'getgb2rp2: copied 7'
     call g2_log(3)
#endif
     
     ! Add Section 8 to the message.
     gribm(lencur + 1) = '7'
     gribm(lencur + 2) = '7'
     gribm(lencur + 3) = '7'
     gribm(lencur + 4) = '7'
 
     ! Clean up.
     if (allocated(csec2)) deallocate(csec2)
     if (allocated(csec7)) deallocate(csec7)
  else  ! do not extract field from message : get entire message
     if (idxver .eq. 1) then
        call g2_gbytec1(cindex, iskip, mypos, int4_bits)    ! bytes to skip in file
        mypos = mypos + int4_bits
        mypos = mypos + 6 * int4_bits
        iskip8 = iskip
     else
        call g2_gbytec81(cindex, iskip8, mypos, int8_bits)    ! bytes to skip in file
        mypos = mypos + int8_bits
        mypos = mypos + 6 * int8_bits
     endif
 
     ! Get the length of the GRIB2 message from the index.
     call g2_gbytec8(cindex, leng8, mypos, int8_bits)
#ifdef LOGGING
     write(g2_log_msg, *) ' iskip8 ', iskip8, ' mypos/8 ', mypos/8, 'index leng8 ', leng8
     call g2_log(2)
#endif
 
     ! Allocate storage to hold the message.
     if (.not. associated(gribm)) allocate(gribm(leng8))
 
     ! Read the message from the file into buffer gribm.
     call bareadl(lugb, iskip8, leng8, lread8, gribm)
     if (leng8 .ne. lread8) then
        deallocate(gribm)
        nullify(gribm)
        iret = 97
        return
     endif
#ifdef LOGGING
     write(g2_log_msg, *) ' read message into gribm, lread8', lread8
     call g2_log(3)
#endif
     
  endif
end subroutine getgb2rp2