getgb2.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, JPDTN, JGDTN
  INTEGER, DIMENSION(:) :: JIDS(*), JPDT(*), JGDT(*)
  LOGICAL, INTENT(IN) :: UNPACK
  INTEGER, INTENT(OUT) :: K, IRET
  TYPE(gribfield), INTENT(OUT) :: GFLD
  CHARACTER(LEN = 1), POINTER, DIMENSION(:) :: CBUF
  integer :: nnum, nlen, lpos, jk, irgi, irgs
 
  ! Declare interfaces (required for cbuf pointer).
  INTERFACE
     SUBROUTINE getidx(LUGB, LUGI, CBUF, NLEN, NNUM, IRGI)
       CHARACTER(LEN = 1), POINTER, DIMENSION(:) :: CBUF
       INTEGER, INTENT(IN) :: LUGB, LUGI
       INTEGER, INTENT(OUT) :: NLEN, NNUM, IRGI
     END SUBROUTINE getidx
  END INTERFACE
 
  ! Determine whether index buffer needs to be initialized.
  irgi = 0
  CALL getidx(lugb, lugi, cbuf, nlen, nnum, irgi)
  IF (irgi .GT. 1) THEN
     iret = 96
     RETURN
  ENDIF
 
  ! Search index buffer.
  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
 
  ! Read local use section, if available.
  CALL getgb2l(lugb, cbuf(lpos), gfld, iret)
 
  ! Read and unpack grib record.
  IF (unpack) THEN
     CALL getgb2r(lugb, cbuf(lpos), gfld, iret)
  ENDIF
  k = jk
END SUBROUTINE getgb2