getgb2r.F90

Go to the documentation of this file.

 
 
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
 
  INTEGER :: LSKIP, SKIP6, SKIP7
  CHARACTER(LEN=1):: CSIZE(4)
  CHARACTER(LEN=1), ALLOCATABLE :: CTEMP(:)
  real, pointer, dimension(:) :: newfld
  integer :: n, lread, j, iskip, iofst, ilen, ierr, idum
 
  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
  CALL g2_gbytec(cindex, lskip, 4*8, 4*8)
  CALL g2_gbytec(cindex, skip6, 24*8, 4*8)
  CALL g2_gbytec(cindex, skip7, 28*8, 4*8)
 
  ! Read and unpack bit_map, if present.
  IF (gfld%ibmap .eq. 0 .OR. gfld%ibmap .eq. 254) THEN
     iskip = lskip + skip6
 
     ! 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_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
  
  ! Get length of section.
  CALL baread(lugb, iskip, 4, lread, csize)    
  CALL g2_gbytec(csize, ilen, 0, 32)
  if (ilen .lt. 6) ilen = 6
  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_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 getgb2r