external/io_grib2/g2lib/gf_unpack1.F

   1       subroutine gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr)
   2 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 !                .      .    .                                       .
   4 ! SUBPROGRAM:    gf_unpack1
   5 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-26
   6 !
   7 ! ABSTRACT: This subroutine unpacks Section 1 (Identification Section)
   8 !   starting at octet 6 of that Section.
   9 !
  10 ! PROGRAM HISTORY LOG:
  11 ! 2000-05-26  Gilbert
  12 ! 2002-01-24  Gilbert  - Changed to dynamically allocate arrays
  13 !                        and to pass pointers to those arrays through
  14 !                        the argument list.
  15 !
  16 ! USAGE:    CALL gf_unpack1(cgrib,lcgrib,iofst,ids,idslen,ierr)
  17 !   INPUT ARGUMENT LIST:
  18 !     cgrib    - Character array containing Section 1 of the GRIB2 message
  19 !     lcgrib   - Length (in bytes) of GRIB message array cgrib.
  20 !     iofst    - Bit offset of the beginning of Section 1.
  21 !
  22 !   OUTPUT ARGUMENT LIST:
  23 !     iofst    - Bit offset at the end of Section 1, returned.
  24 !     ids      - Pointer to integer array containing information read from
  25 !                Section 1, the Identification section.
  26 !            ids(1)  = Identification of originating Centre
  27 !                                 ( see Common Code Table C-1 )
  28 !            ids(2)  = Identification of originating Sub-centre
  29 !            ids(3)  = GRIB Master Tables Version Number
  30 !                                 ( see Code Table 1.0 )
  31 !            ids(4)  = GRIB Local Tables Version Number
  32 !                                 ( see Code Table 1.1 )
  33 !            ids(5)  = Significance of Reference Time (Code Table 1.2)
  34 !            ids(6)  = Year ( 4 digits )
  35 !            ids(7)  = Month
  36 !            ids(8)  = Day
  37 !            ids(9)  = Hour
  38 !            ids(10)  = Minute
  39 !            ids(11)  = Second
  40 !            ids(12)  = Production status of processed data
  41 !                                 ( see Code Table 1.3 )
  42 !            ids(13)  = Type of processed data ( see Code Table 1.4 )
  43 !     idslen   - Number of elements in ids().
  44 !     ierr     - Error return code.
  45 !                0 = no error
  46 !                6 = memory allocation error
  47 !
  48 ! REMARKS:
  49 !
  50 ! ATTRIBUTES:
  51 !   LANGUAGE: Fortran 90
  52 !   MACHINE:  IBM SP
  53 !
  54 !$$$
  55
  56       character(len=1),intent(in) :: cgrib(lcgrib)
  57       integer,intent(in) :: lcgrib
  58       integer,intent(inout) :: iofst
  59       integer,pointer,dimension(:) :: ids
  60       integer,intent(out) :: ierr,idslen
  61
  62       integer,dimension(:) :: mapid(13)
  63
  64       data mapid /2,2,1,1,1,2,1,1,1,1,1,1,1/
  65
  66       ierr=0
  67       idslen=13
  68       nullify(ids)
  69
  70       call g2lib_gbyte(cgrib,lensec,iofst,32)        ! Get Length of Section
  71       iofst=iofst+32
  72       iofst=iofst+8     ! skip section number
  73       !
  74       !   Unpack each value into array ids from the
  75       !   the appropriate number of octets, which are specified in
  76       !   corresponding entries in array mapid.
  77       !
  78       istat=0
  79       allocate(ids(idslen),stat=istat)
  80       if (istat.ne.0) then
  81          ierr=6
  82          nullify(ids)
  83          return
  84       endif
  85
  86       do i=1,idslen
  87         nbits=mapid(i)*8
  88         call g2lib_gbyte(cgrib,ids(i),iofst,nbits)
  89         iofst=iofst+nbits
  90       enddo
  91
  92       return    ! End of Section 1 processing
  93       end