external/io_grib2/g2lib/gf_unpack2.F

   1       subroutine gf_unpack2(cgrib,lcgrib,iofst,lencsec2,csec2,ierr)
   2 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 !                .      .    .                                       .
   4 ! SUBPROGRAM:    gf_unpack2
   5 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2002-04-09
   6 !
   7 ! ABSTRACT: This subroutine unpacks Section 2 (Local Use Section)
   8 !           as defined in GRIB Edition 2.
   9 !
  10 ! PROGRAM HISTORY LOG:
  11 ! 2002-04-09  Gilbert
  12 !
  13 ! USAGE:    CALL gf_unpack2(cgrib,lcgrib,iofst,lencsec2,csec2,ierr)
  14 !   INPUT ARGUMENT LIST:
  15 !     cgrib    - Character array containing Section 2 of the GRIB2 message
  16 !     lcgrib   - Length (in bytes) of GRIB message array cgrib.
  17 !     iofst    - Bit offset of the beginning of Section 2.
  18 !
  19 !   OUTPUT ARGUMENT LIST:
  20 !     iofst    - Bit offset at the end of Section 2, returned.
  21 !     lencsec2 - Length (in octets) of Local Use data
  22 !     csec2()  - Pointer to a character*1 array containing local use data
  23 !     ierr     - Error return code.
  24 !                0 = no error
  25 !                2 = Array passed is not section 2
  26 !                6 = memory allocation error
  27 !
  28 ! REMARKS: None
  29 !
  30 ! ATTRIBUTES:
  31 !   LANGUAGE: Fortran 90
  32 !   MACHINE:  IBM SP
  33 !
  34 !$$$
  35
  36       character(len=1),intent(in) :: cgrib(lcgrib)
  37       integer,intent(in) :: lcgrib
  38       integer,intent(inout) :: iofst
  39       integer,intent(out) :: lencsec2
  40       integer,intent(out) :: ierr
  41       character(len=1),pointer,dimension(:) :: csec2
  42
  43       ierr=0
  44       lencsec2=0
  45       nullify(csec2)
  46
  47       call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
  48       iofst=iofst+32
  49       lencsec2=lensec-5
  50       call g2lib_gbyte(cgrib,isecnum,iofst,8)         ! Get Section Number
  51       iofst=iofst+8
  52       ipos=(iofst/8)+1
  53
  54       if ( isecnum.ne.2 ) then
  55          ierr=6
  56          print *,'gf_unpack2: Not Section 2 data. '
  57          return
  58       endif
  59
  60       allocate(csec2(lencsec2),stat=istat)
  61       if (istat.ne.0) then
  62          ierr=6
  63          nullify(csec2)
  64          return
  65       endif
  66
  67       csec2(1:lencsec2)=cgrib(ipos:ipos+lencsec2-1)
  68       iofst=iofst+(lencsec2*8)
  69
  70       return    ! End of Section 2 processing
  71       end
  72