-
Notifications
You must be signed in to change notification settings - Fork 15
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
converted getgb2r() and getgb2l() to F90 (#527)
* converted getgb2l to F90 * converted getgb2r to F90
- Loading branch information
1 parent
53a5c38
commit e366c75
Showing
5 changed files
with
248 additions
and
244 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
Oops, something went wrong.