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 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
 
  ! 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 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
  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 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
 
  ! Get info.
  nullify(gfld%local)
  iret = 0
  mypos = int4_bits
  if (idxver .eq. 1) then
     call g2_gbytec(cindex, lskip, mypos, int4_bits)
     mypos = mypos + int4_bits
     lskip8 = lskip
  else
     call g2_gbytec8(cindex, lskip8, mypos, int8_bits)
     mypos = mypos + int8_bits
  endif
  call g2_gbytec(cindex, skip2, mypos, int4_bits)
 
  ! Read and unpack local use section, if present.
  if (skip2 .ne. 0) then
     iskip8 = lskip8 + skip2
 
     ! Get length of section.
     call bareadl(lugb, iskip8, 4_8, lread8, csize)    
     call g2_gbytec(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, jpdtn, jgdtn
  integer, dimension(:) :: jids(*), jpdt(*), jgdt(*)
  logical, intent(in) :: extract
  integer, intent(out) :: k, iret, leng
  character(len = 1), pointer, dimension(:) :: gribm
 
  type(gribfield) :: gfld
  integer :: msk1, irgi, irgs, jk, lpos, msk2, mskp, nlen, nmess, nnum
 
  character(len = 1), pointer, dimension(:) :: cbuf
  parameter(msk1 = 32000, msk2 = 4000)
 
  ! Declare interfaces (required for cbuf pointer).
  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 getgb2rp(lugb, cindex, extract, gribm, leng, iret)
       integer, intent(in) :: lugb
       character(len = 1), intent(in) :: cindex(*)
       logical, intent(in) :: extract
       integer, intent(out) :: leng, iret
       character(len = 1), pointer, dimension(:) :: gribm
     end subroutine getgb2rp
  end interface
 
  ! Initialize the index information in cbuf.
  irgi = 0
  if (lugi .gt. 0) then
     call getg2i(lugi, cbuf, nlen, nnum, irgi)
  elseif (lugi .le. 0) then
     mskp = 0
     call getg2ir(lugb, msk1, msk2, mskp, 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 getgb2s(cbuf, 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.
  nullify(gribm)
  call getgb2rp(lugb, cbuf(lpos:), extract, gribm, leng, iret)
 
  k = jk
 
  ! Free cbuf memory allocated in getg2i/getg2ir().
  if (associated(cbuf)) deallocate(cbuf)
  
  call gf_free(gfld)
end subroutine getgb2p
 
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 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
  character(len=1):: csize(4)
  character(len=1), allocatable :: ctemp(:)
  real, pointer, dimension(:) :: newfld
  integer :: n, j, iskip, iofst, ilen, ierr, idum
  integer :: inc
  integer (kind = 8) :: lskip8, lread8, ilen8, iskip8
  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
  end interface
 
  ! Get info.
  nullify(gfld%bmap, gfld%fld)
  iret = 0
  inc = 0
  if (idxver .eq. 1) then
     call g2_gbytec(cindex, lskip, int4_bits, int4_bits)
     lskip8 = lskip
  else
     inc = 4
     call g2_gbytec8(cindex, lskip8, int4_bits, int8_bits)
     lskip = int(lskip8, kind(4))
  endif
  call g2_gbytec(cindex, skip6, (24 + inc) * int1_bits, int4_bits)
  call g2_gbytec(cindex, skip7, (28 + inc) * int1_bits, int4_bits)
 
  ! Read and unpack bit_map, if present.
  if (gfld%ibmap .eq. 0 .or. gfld%ibmap .eq. 254) then
     iskip = lskip + skip6
     iskip8 = lskip8 + skip6
 
     ! get length of section.
     call bareadl(lugb, iskip8, 4_8, lread8, csize)
     call g2_gbytec(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_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.
  iskip = lskip + skip7
  iskip8 = lskip8 + skip7
  
  ! Get length of section.
  call bareadl(lugb, iskip8, 4_8, lread8, csize)    
  call g2_gbytec(csize, ilen, 0, 32)
  if (ilen .lt. 6) ilen = 6
  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_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
 
  interface
     subroutine getgb2rp2(lugb, idxver, cindex, extract, gribm, leng, iret)
       integer, intent(in) :: lugb, idxver
       character(len = 1), intent(in) :: cindex(*)
       logical, intent(in) :: extract
       character(len = 1), pointer, dimension(:) :: gribm
       integer, intent(out) :: leng, iret
     end subroutine getgb2rp2
  end interface
 
  call getgb2rp2(lugb, 1, cindex, extract, gribm, leng, iret)
 
end subroutine getgb2rp
 
subroutine getgb2rp2(lugb, idxver, cindex, extract, gribm, leng, iret)
  implicit none
 
  integer, intent(in) :: lugb, idxver
  character(len = 1), intent(in) :: cindex(*)
  logical, intent(in) :: extract
  integer, intent(out) :: leng, iret
  character(len = 1), pointer, dimension(:) :: gribm
 
  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 :: 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, leng8, len2_8, len7_8, len6_8
 
  iret = 0
 
  ! Extract grib message from file.
  mypos = int4_bits
  if (extract) then
     len0 = 16
     len8 = 4
     if (idxver .eq. 1) then
        call g2_gbytec(cindex, iskip, mypos, int4_bits)    ! bytes to skip in file
        mypos = mypos + int4_bits
        iskip8 = iskip
     else
        inc = 4
        call g2_gbytec8(cindex, iskip8, mypos, int8_bits)    ! bytes to skip in file
        mypos = mypos + int8_bits
        iskip = int(iskip8, kind(4))
     endif
     call g2_gbytec(cindex, iskp2, mypos, int4_bits)    ! bytes to skip for section 2
     mypos = mypos + int4_bits
     if (iskp2 .gt. 0) then
        call bareadl(lugb, iskip8 + iskp2, 4_8, lread8, ctemp)
        call g2_gbytec(ctemp, len2, 0, int4_bits)      ! length of section 2
        allocate(csec2(len2))
        len2_8 = len2
        call bareadl(lugb, iskip8 + iskp2, len2_8, lread8, csec2)
     else
        len2 = 0
     endif
     mypos = mypos + 32 * int1_bits ! skip ahead in the cindex
     call g2_gbytec(cindex, len1, mypos, int4_bits)      ! length of section 1
     ipos = 44 + len1
     mypos = mypos + len1 * int1_bits ! skip ahead in the cindex
     call g2_gbytec(cindex, len3, mypos, int4_bits)      ! length of section 3
     ipos = ipos + len3
     mypos = mypos + len3 * int1_bits ! skip ahead in the cindex
     call g2_gbytec(cindex, len4, mypos, int4_bits)      ! length of section 4
     ipos = ipos + len4
     mypos = mypos + len4 * int1_bits ! skip ahead in the cindex
     call g2_gbytec(cindex, len5, mypos, int4_bits)      ! length of section 5
     ipos = ipos + len5
     mypos = mypos + len5 * int1_bits ! skip ahead in the cindex
     call g2_gbytec(cindex, len6, mypos, int4_bits)      ! length of section 6
     ipos = ipos + 5
     mypos = mypos + len6 * int1_bits ! skip ahead in the cindex
     call g2_gbytec(cindex, ibmap, mypos, int1_bits)      ! bitmap indicator
     if (ibmap .eq. 254) then
        call g2_gbytec(cindex, iskp6, (24 + inc) * int1_bits, int4_bits)    ! bytes to skip for section 6
        !call baread(lugb, iskip + iskp6, 4, lread, ctemp)
        call bareadl(lugb, iskip8 + iskp6, 4_8, lread8, ctemp)
        call g2_gbytec(ctemp, len6, 0, int4_bits)      ! length of section 6
     endif
 
     !  read in section 7 from file
     call g2_gbytec(cindex, iskp7, (28 + inc) * int1_bits, int4_bits)    ! bytes to skip for section 7
     !call baread(lugb, iskip + iskp7, 4, lread, ctemp)
     call bareadl(lugb, iskip8 + iskp7, 4_8, lread8, ctemp)
     call g2_gbytec(ctemp, len7, 0, int4_bits)      ! length of section 7
     allocate(csec7(len7))
     !call baread(lugb, iskip + iskp7, len7, lread, csec7)
     len7_8 = len7
     call bareadl(lugb, iskip8 + iskp7, len7_8, lread8, csec7)
 
     leng = len0 + len1 + len2 + len3 + len4 + len5 + len6 + len7 + len8
     if (.not. associated(gribm)) allocate(gribm(leng))
 
     ! 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)
     gribm(8) = cindex(41 + inc)
     gribm(9) = char(0)
     gribm(10) = char(0)
     gribm(11) = char(0)
     gribm(12) = char(0)
     call g2_sbytec(gribm, leng, 12*8, int4_bits)
 
     ! Copy Section 1
     gribm(17:16 + len1) = cindex(45 + inc:44 + inc + len1)
     lencur = 16 + inc + len1
     ipos = 44 + inc + len1
 
     ! Copy Section 2, if necessary
     if (iskp2 .gt. 0) then
        gribm(lencur + 1:lencur + len2) = csec2(1:len2)
        lencur = lencur + len2
     endif
 
     ! Copy Sections 3 through 5
     gribm(lencur + 1:lencur + len3 + len4 + len5) = cindex(ipos + 1:ipos + len3 + len4 + len5)
     lencur = lencur + len3 + len4 + len5
     ipos = ipos + len3 + len4 + len5
 
     ! Copy Section 6
     if (len6 .eq. 6 .and. ibmap .ne. 254) then
        gribm(lencur + 1:lencur + len6) = cindex(ipos + 1:ipos + len6)
        lencur = lencur + len6
     else
        call g2_gbytec(cindex, iskp6, (24 + inc) * 8, int4_bits)    ! bytes to skip for section 6
        call bareadl(lugb, iskip8 + iskp6, 4_8, lread8, ctemp)
        call g2_gbytec(ctemp, len6, 0, int4_bits)      ! length of section 6
        allocate(csec6(len6))
        len6_8 = len6
        call bareadl(lugb, iskip8 + iskp6, len6_8, lread8, csec6)
        gribm(lencur + 1:lencur + len6) = csec6(1:len6)
        lencur = lencur + len6
        if (allocated(csec6)) deallocate(csec6)
     endif
 
     ! Copy Section 7
     gribm(lencur + 1:lencur + len7) = csec7(1:len7)
     lencur = lencur + len7
 
     ! Section 8
     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_gbytec(cindex, iskip, mypos, int4_bits)    ! bytes to skip in file
        mypos = mypos + int4_bits
        iskip8 = iskip
     else
        call g2_gbytec8(cindex, iskip8, mypos, int8_bits)    ! bytes to skip in file
        mypos = mypos + int8_bits
     endif
     mypos = mypos + 7 * int4_bits
     call g2_gbytec(cindex, leng, mypos, int4_bits)      ! length of grib message
     if (.not. associated(gribm)) allocate(gribm(leng))
     leng8 = leng
     call bareadl(lugb, iskip8, leng8, lread8, gribm)
     if (leng8 .ne. lread8) then
        deallocate(gribm)
        nullify(gribm)
        iret = 97
        return
     endif
  endif
end subroutine getgb2rp2