source: trunk/WRF.COMMON/WRFV3/external/io_grib2/g2lib/jpcunpack.F @ 3567

Last change on this file since 3567 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: 1.8 KB
Line 
1      subroutine jpcunpack(cpack,len,idrstmpl,ndpts,fld)
2!$$$  SUBPROGRAM DOCUMENTATION BLOCK
3!                .      .    .                                       .
4! SUBPROGRAM:    jpcunpack
5!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2002-12-17
6!
7! ABSTRACT: This subroutine unpacks a data field that was packed into a
8!   JPEG2000 code stream
9!   using info from the GRIB2 Data Representation Template 5.40 or 5.40000.
10!
11! PROGRAM HISTORY LOG:
12! 2002-12-17  Gilbert
13!
14! USAGE:    CALL jpcunpack(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.40 or 5.40000
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      integer :: dec_jpeg2000
42
43      ieee = idrstmpl(1)
44      call rdieee(ieee,ref,1)
45      bscale = 2.0**real(idrstmpl(2))
46      dscale = 10.0**real(-idrstmpl(3))
47      nbits = idrstmpl(4)
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         iret=dec_jpeg2000(cpack,len,ifld)
55         do j=1,ndpts
56           fld(j)=((real(ifld(j))*bscale)+ref)*dscale
57         enddo
58      else
59         do j=1,ndpts
60           fld(j)=ref
61         enddo
62      endif
63
64
65      return
66      end
Note: See TracBrowser for help on using the repository browser.