updated top-level README and version_decl for V4.4.2 (#1795)
[WRF.git] / external / io_grib2 / g2lib / simunpack.F
blobebbebae71fec19f93be4a25e2d40a778171281f9
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
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.
11 ! PROGRAM HISTORY LOG:
12 ! 2000-06-21  Gilbert
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
22 !   OUTPUT ARGUMENT LIST:
23 !     fld()    - Contains the unpacked data values
25 ! REMARKS: None
27 ! ATTRIBUTES:
28 !   LANGUAGE: XL Fortran 90
29 !   MACHINE:  IBM SP
31 !$$$
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)
38       integer :: ifld(ndpts)
39       integer(4) :: ieee
40       real :: ref,bscale,dscale
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)
49 !  if nbits equals 0, we have a constant field where the reference value
50 !  is the data value at each gridpoint
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
64       return
65       end