source: trunk/WRF.COMMON/WRFV2/external/io_grib2/g2lib/simunpack.F @ 2756

Last change on this file since 2756 was 11, checked in by aslmd, 14 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien

File size: 1.8 KB
Line 
1      subroutine simunpack(cpack,len,idrstmpl,ndpts,fld)
2!$$$  SUBPROGRAM DOCUMENTATION BLOCK
3!                .      .    .                                       .
4! SUBPROGRAM:    simunpack
5!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2000-06-21
6!
7! ABSTRACT: This subroutine unpacks a data field that was packed using a
8!   simple packing algorithm as defined in the GRIB2 documention,
9!   using info from the GRIB2 Data Representation Template 5.0.
10!
11! PROGRAM HISTORY LOG:
12! 2000-06-21  Gilbert
13!
14! USAGE:    CALL simunpack(cpack,len,idrstmpl,ndpts,fld)
15!   INPUT ARGUMENT LIST:
16!     cpack    - The packed data field (character*1 array)
17!     len      - length of packed field cpack().
18!     idrstmpl - Contains the array of values for Data Representation
19!                Template 5.0
20!     ndpts    - The number of data values to unpack
21!
22!   OUTPUT ARGUMENT LIST:
23!     fld()    - Contains the unpacked data values
24!
25! REMARKS: None
26!
27! ATTRIBUTES:
28!   LANGUAGE: XL Fortran 90
29!   MACHINE:  IBM SP
30!
31!$$$
32
33      character(len=1),intent(in) :: cpack(len)
34      integer,intent(in) :: ndpts,len
35      integer,intent(in) :: idrstmpl(*)
36      real,intent(out) :: fld(ndpts)
37
38      integer :: ifld(ndpts)
39      integer(4) :: ieee
40      real :: ref,bscale,dscale
41
42      ieee = idrstmpl(1)
43      call rdieee(ieee,ref,1)
44      bscale = 2.0**real(idrstmpl(2))
45      dscale = 10.0**real(-idrstmpl(3))
46      nbits = idrstmpl(4)
47      itype = idrstmpl(5)
48!
49!  if nbits equals 0, we have a constant field where the reference value
50!  is the data value at each gridpoint
51!
52      if (nbits.ne.0) then
53         call g2lib_gbytes(cpack,ifld,0,nbits,0,ndpts)
54         do j=1,ndpts
55           fld(j)=((real(ifld(j))*bscale)+ref)*dscale
56         enddo
57      else
58         do j=1,ndpts
59           fld(j)=ref
60         enddo
61      endif
62
63
64      return
65      end
Note: See TracBrowser for help on using the repository browser.