source: trunk/WRF.COMMON/WRFV3/external/io_grib2/g2lib/gf_unpack1.F @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size

File size: 3.2 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.