Skip to content

Commit

Permalink
converted getgb2r() and getgb2l() to F90 (#527)
Browse files Browse the repository at this point in the history
* converted getgb2l to F90

* converted getgb2r to F90
  • Loading branch information
edwardhartnett authored Aug 9, 2023
1 parent 53a5c38 commit e366c75
Show file tree
Hide file tree
Showing 5 changed files with 248 additions and 244 deletions.
4 changes: 2 additions & 2 deletions src/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,8 @@
# These are the fortran source files.
set(fortran_src addfield.f addgrid.F90 addlocal.F90 cmplxpack.f compack.f
comunpack.f drstemplates.F90 g2_gbytesc.F90 g2grids.F90 gb_info.F90
getdim.f getfield.F90 getg2i.F90 getg2ir.F90 getgb2.F90 getgb2l.f getgb2p.F90
getgb2r.f getgb2rp.f getgb2s.F90 getidx.F90 getlocal.f getpoly.f
getdim.f getfield.F90 getg2i.F90 getg2ir.F90 getgb2.F90 getgb2l.F90 getgb2p.F90
getgb2r.F90 getgb2rp.f getgb2s.F90 getidx.F90 getlocal.f getpoly.f
gettemplates.F90 gf_free.F90 gf_getfld.F90 gf_unpack1.F90 gf_unpack2.F90
gf_unpack3.F90 gf_unpack4.f gf_unpack5.f gf_unpack6.F90 gf_unpack7.f
gribcreate.F90 gribend.F90 gribinfo.F90
Expand Down
94 changes: 94 additions & 0 deletions src/getgb2l.F90
Original file line number Diff line number Diff line change
@@ -0,0 +1,94 @@
!> @file
!> @brief This subroutine reads and unpacks a local use section from a
!> GRIB2 message.
!> @author Stephen Gilbert @date 2002-05-07

!> This subroutine reads and unpacks a local use section from a GRIB2
!> message.
!>
!> This subroutine decodes information for the selected grib field and
!> returns it in a derived type variable, gfld. gfld is of type @ref
!> grib_mod::gribfield. Users of this routine will need to include the
!> line "use grib_mod" in their calling routine.
!>
!> This subprogram is intended for private use by getgb2 routines
!> only.
!>
!> Note that derived type gribfield contains pointers to many arrays
!> of data. The memory for these arrays is allocated when the values
!> in the arrays are set, to help minimize problems with array
!> overloading. Because of this users should free this memory, when it
!> is no longer needed, by an explicit call to subroutine gf_free().
!>
!> @param[in] LUGB integer unit of the unblocked grib data file.
!> @param[in] CINDEX index record of the grib field (see docblock of
!> subroutine ixgb2 for description of an index record.)
!> @param[out] GFLD derived type gribfield @ref grib_mod::gribfield.
!> @param[out] IRET integer return code
!> - 0 all ok
!> - 97 error reading grib file
!> - other gf_getfld grib2 unpacker return code
!>
!> @note Do not engage the same logical unit from more than one
!> processor.
!>
!> @author Stephen Gilbert @date 2002-05-07
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
92 changes: 0 additions & 92 deletions src/getgb2l.f

This file was deleted.

152 changes: 152 additions & 0 deletions src/getgb2r.F90
Original file line number Diff line number Diff line change
@@ -0,0 +1,152 @@
!> @file
!> @brief Read and unpack sections 6 and 7 from a GRIB2 message.
!> @author Stephen Gilbert @date 2002-01-11

!> Read and unpack sections 6 and 7 from a GRIB2 message.
!>
!> It assumes that the metadata for this field already exists in
!> derived type @ref grib_mod::gribfield. Specifically, it requires
!> gfld\%ibmap, gfld\%ngrdpts, gfld\%idrtnum, gfld\%idrtmpl, and
!> gfld\%ndpts.
!>
!> It decodes information for the selected grib field and returns it
!> in a derived type variable, gfld, of type @ref
!> grib_mod::gribfield. Users of this routine will need to include the
!> line "use grib_mod" in their calling routine.
!>
!> This subprogram is intended for private use by getgb2()
!> routines only.
!>
!> Derived type gribfield contains pointers to many arrays of
!> data. Users must free this memory by calling gf_free().
!>
!> @note Do not engage the same logical unit from more than one
!> processor.
!>
!> @param[in] LUGB integer unit of the unblocked grib data file.
!> File must be opened with [baopen() or baopenr()]
!> (https://noaa-emc.github.io/NCEPLIBS-bacio/) before calling
!> this routine.
!> @param[in] CINDEX index record of the grib field (see
!> subroutine ixgb2() for description of an index record.)
!> @param[out] GFLD derived type @ref grib_mod::gribfield.
!> @param[out] IRET integer return code
!> - 0 all ok
!> - 97 error reading grib file
!> - other gf_getfld grib2 unpacker return code
!>
!> @author Stephen Gilbert @date 2002-01-11
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
Loading

0 comments on commit e366c75

Please sign in to comment.