Merge branch 'release-v4.6.0'
[WPS.git] / ungrib / src / ngl / g2 / simunpack.f
blob612a28355fbeb434781167d043594268e0ef6b44
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 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