ungrib/src/ngl/g2/pngunpack.F

   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 #ifdef USE_PNG
  44
  45       ieee = idrstmpl(1)
  46       call rdieee(ieee,ref,1)
  47       bscale = 2.0**real(idrstmpl(2))
  48       dscale = 10.0**real(-idrstmpl(3))
  49       nbits = idrstmpl(4)
  50       itype = idrstmpl(5)
  51 !
  52 !  if nbits equals 0, we have a constant field where the reference value
  53 !  is the data value at each gridpoint
  54 !
  55       if (nbits.ne.0) then
  56          allocate(ctemp(ndpts*4))
  57          iret=dec_png(cpack,width,height,ctemp)
  58          call gbytes(ctemp,ifld,0,nbits,0,ndpts)
  59          deallocate(ctemp)
  60          do j=1,ndpts
  61            fld(j)=((real(ifld(j))*bscale)+ref)*dscale
  62          enddo
  63       else
  64          do j=1,ndpts
  65            fld(j)=ref
  66          enddo
  67       endif
  68
  69
  70 #endif /* USE_PNG */
  71       return
  72       end