getgb2l.F90

Go to the documentation of this file.

 
 
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
 
  INTEGER :: LSKIP, SKIP2
  CHARACTER(LEN = 1):: CSIZE(4)
  CHARACTER(LEN = 1), ALLOCATABLE :: CTEMP(:)
  integer :: ilen, iofst, iskip, lread, ierr
 
  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
  CALL g2_gbytec(cindex, lskip, 4 * 8, 4 * 8)
  CALL g2_gbytec(cindex, skip2, 8 * 8, 4 * 8)
 
  ! Read and unpack local use section, if present.
  IF (skip2 .NE. 0) THEN
     iskip = lskip + skip2
 
     ! Get length of section.
     CALL baread(lugb, iskip, 4, lread, csize)    
     CALL g2_gbytec(csize, ilen, 0, 32)
     ALLOCATE(ctemp(ilen))
 
     ! Read in section.
     CALL baread(lugb, iskip, ilen, lread, ctemp)  
     IF (ilen .NE. lread) 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 getgb2l