getgb2rp.f

Go to the documentation of this file.

C>    @file
C>    @brief This subroutine find and extracts the index for the
C>    requested field from a grib file.
C>    @author Stephen Gilbert @date 2003-12-31
C>
 
C>    This subroutine find and extracts a grib message from a file given
C>    the index for the requested field. The grib message returned can
C>    contain only the requested field (extract=.true.). or the complete
C>    grib message originally containing the desired field can be
C>    returned (extract=.false.) even if other fields were included in
C>    the grib message. If the grib field is not found, then the return
C>    code will be nonzero.
 
C>    @param[in] LUGB integer unit of the unblocked grib data file.
C>    file must be opened with baopen or baopenr before calling
C>    this routine.
C>    @param[in] CINDEX index record of the grib field (see docblock of
C>    subroutine ixgb2() for description of an index record.)
C>    @param[in] EXTRACT logical value indicating whether to return a
C>    grib2 message with just the requested field, or the entire
C>    grib2 message containing the requested field.
C>    - .true. = return grib2 message containing only the requested field.
C>    - .false. = return entire grib2 message containing the requested field.
C>    @param[out] GRIBM returned grib message.
C>    @param[out] LENG length of returned grib message in bytes.
C>    @param[out] IRET integer return code
C>    - 0 all ok
C>    - 97 error reading grib file
C>
C>    @author Stephen Gilbert @date 2003-12-31
C>
 
C-----------------------------------------------------------------------
      SUBROUTINE getgb2rp(LUGB,CINDEX,EXTRACT,GRIBM,LENG,IRET)
 
      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
 
      iret=0
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  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
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      RETURN
      END