getgb2rp.F90

Go to the documentation of this file.

 
 
subroutine getgb2rp(lugb, cindex, extract, gribm, leng, iret)
  implicit none
 
  integer, intent(in) :: lugb
  character(len = 1), intent(in) :: cindex(*)
  logical, intent(in) :: extract
  integer, intent(out) :: leng, iret
  character(len = 1), pointer, dimension(:) :: gribm
 
  integer, parameter :: zero = 0
  character(len = 1), allocatable, dimension(:) :: csec2, csec6, csec7
  character(len = 4) :: ctemp
  integer :: lencur, lread, len0, ibmap, ipos, iskip
  integer :: len7, len8, len3, len4, len5, len6, len1, len2
  integer :: iskp2, iskp6, iskp7
 
  iret = 0
 
  ! Extract grib message from file.
  IF (extract) THEN
     len0 = 16
     len8 = 4
     CALL g2_gbytec(cindex, iskip, 4*8, 4*8)    ! BYTES TO SKIP IN FILE
     CALL g2_gbytec(cindex, iskp2, 8*8, 4*8)    ! BYTES TO SKIP FOR section 2
     if (iskp2 .gt. 0) then
        CALL baread(lugb, iskip + iskp2, 4, lread, ctemp)
        CALL g2_gbytec(ctemp, len2, 0, 4*8)      ! LENGTH OF SECTION 2
        ALLOCATE(csec2(len2))
        CALL baread(lugb, iskip + iskp2, len2, lread, csec2)
     else
        len2 = 0
     endif
     CALL g2_gbytec(cindex, len1, 44*8, 4*8)      ! LENGTH OF SECTION 1
     ipos = 44 + len1
     CALL g2_gbytec(cindex, len3, ipos*8, 4*8)      ! LENGTH OF SECTION 3
     ipos = ipos + len3
     CALL g2_gbytec(cindex, len4, ipos*8, 4*8)      ! LENGTH OF SECTION 4
     ipos = ipos + len4
     CALL g2_gbytec(cindex, len5, ipos*8, 4*8)      ! LENGTH OF SECTION 5
     ipos = ipos + len5
     CALL g2_gbytec(cindex, len6, ipos*8, 4*8)      ! LENGTH OF SECTION 6
     ipos = ipos + 5
     CALL g2_gbytec(cindex, ibmap, ipos*8, 1*8)      ! Bitmap indicator
     IF (ibmap .eq. 254) THEN
        CALL g2_gbytec(cindex, iskp6, 24*8, 4*8)    ! BYTES TO SKIP FOR section 6
        CALL baread(lugb, iskip + iskp6, 4, lread, ctemp)
        CALL g2_gbytec(ctemp, len6, 0, 4*8)      ! LENGTH OF SECTION 6
     ENDIF
 
     !  READ IN SECTION 7 from file
     CALL g2_gbytec(cindex, iskp7, 28*8, 4*8)    ! BYTES TO SKIP FOR section 7
     CALL baread(lugb, iskip + iskp7, 4, lread, ctemp)
     CALL g2_gbytec(ctemp, len7, 0, 4*8)      ! LENGTH OF SECTION 7
     ALLOCATE(csec7(len7))
     CALL baread(lugb, iskip + iskp7, len7, lread, csec7)
 
     leng = len0 + len1 + len2 + len3 + len4 + len5 + len6 + len7 + len8
     IF (.NOT. ASSOCIATED(gribm)) ALLOCATE(gribm(leng))
 
     ! Create Section 0
     gribm(1) = 'G'
     gribm(2) = 'R'
     gribm(3) = 'I'
     gribm(4) = 'B'
     gribm(5) = char(0)
     gribm(6) = char(0)
     gribm(7) = cindex(42)
     gribm(8) = cindex(41)
     gribm(9) = char(0)
     gribm(10) = char(0)
     gribm(11) = char(0)
     gribm(12) = char(0)
     CALL g2_sbytec(gribm, leng, 12*8, 4*8)
 
     ! Copy Section 1
     gribm(17:16 + len1) = cindex(45:44 + len1)
     lencur = 16 + len1
     ipos = 44 + len1
 
     ! Copy Section 2, if necessary
     if (iskp2 .gt. 0) then
        gribm(lencur + 1:lencur + len2) = csec2(1:len2)
        lencur = lencur + len2
     endif
 
     ! Copy Sections 3 through 5
     gribm(lencur + 1:lencur + len3 + len4 + len5) = cindex(ipos + 1:ipos + len3 + len4 + len5)
     lencur = lencur + len3 + len4 + len5
     ipos = ipos + len3 + len4 + len5
 
     ! Copy Section 6
     if (len6 .eq. 6 .AND. ibmap .ne. 254) then
        gribm(lencur + 1:lencur + len6) = cindex(ipos + 1:ipos + len6)
        lencur = lencur + len6
     else
        CALL g2_gbytec(cindex, iskp6, 24*8, 4*8)    ! BYTES TO SKIP FOR section 6
        CALL baread(lugb, iskip + iskp6, 4, lread, ctemp)
        CALL g2_gbytec(ctemp, len6, 0, 4*8)      ! LENGTH OF SECTION 6
        ALLOCATE(csec6(len6))
        CALL baread(lugb, iskip + iskp6, len6, lread, csec6)
        gribm(lencur + 1:lencur + len6) = csec6(1:len6)
        lencur = lencur + len6
        IF (allocated(csec6)) DEALLOCATE(csec6)
     endif
 
     ! Copy Section 7
     gribm(lencur + 1:lencur + len7) = csec7(1:len7)
     lencur = lencur + len7
 
     ! Section 8
     gribm(lencur + 1) = '7'
     gribm(lencur + 2) = '7'
     gribm(lencur + 3) = '7'
     gribm(lencur + 4) = '7'
 
     !  clean up
     IF (allocated(csec2)) DEALLOCATE(csec2)
     IF (allocated(csec7)) deallocate(csec7)
  ELSE    ! DO NOT extract field from message :  Get entire message
     CALL g2_gbytec(cindex, iskip, 4*8, 4*8)    ! BYTES TO SKIP IN FILE
     CALL g2_gbytec(cindex, leng, 36*8, 4*8)      ! LENGTH OF GRIB MESSAGE
     IF (.NOT. ASSOCIATED(gribm)) ALLOCATE(gribm(leng))
     CALL baread(lugb, iskip, leng, lread, gribm)
     IF (leng .NE. lread ) THEN
        DEALLOCATE(gribm)
        NULLIFY(gribm)
        iret = 97
        RETURN
     ENDIF
  ENDIF
END SUBROUTINE getgb2rp