source: lmdz_wrf/WRFV3/external/io_grib2/g2lib/pngunpack.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 2.0 KB
Line 
1      subroutine pngunpack(cpack,len,idrstmpl,ndpts,fld)
2!$$$  SUBPROGRAM DOCUMENTATION BLOCK
3!                .      .    .                                       .
4! SUBPROGRAM:    pngunpack
5!   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2000-06-21
6!
7! ABSTRACT: This subroutine unpacks a data field that was packed into a
8!   PNG image format
9!   using info from the GRIB2 Data Representation Template 5.41 or 5.40010.
10!
11! PROGRAM HISTORY LOG:
12! 2000-06-21  Gilbert
13!
14! USAGE:    CALL pngunpack(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.41 or 5.40010
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      character(len=1),allocatable :: ctemp(:)
40      integer(4) :: ieee
41      real :: ref,bscale,dscale
42      integer :: dec_png,width,height
43
44      ieee = idrstmpl(1)
45      call rdieee(ieee,ref,1)
46      bscale = 2.0**real(idrstmpl(2))
47      dscale = 10.0**real(-idrstmpl(3))
48      nbits = idrstmpl(4)
49      itype = idrstmpl(5)
50!
51!  if nbits equals 0, we have a constant field where the reference value
52!  is the data value at each gridpoint
53!
54      if (nbits.ne.0) then
55         allocate(ctemp(ndpts*4))
56         iret=dec_png(cpack,width,height,ctemp)
57         call g2lib_gbytes(ctemp,ifld,0,nbits,0,ndpts)
58         deallocate(ctemp)
59         do j=1,ndpts
60           fld(j)=((real(ifld(j))*bscale)+ref)*dscale
61         enddo
62      else
63         do j=1,ndpts
64           fld(j)=ref
65         enddo
66      endif
67
68
69      return
70      end
Note: See TracBrowser for help on using the repository browser.