subroutine specunpack(cpack,len,idrstmpl,ndpts,JJ,KK,MM,fld) 1,3
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! SUBPROGRAM: specunpack
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-12-19
!
! ABSTRACT: This subroutine unpacks a spectral data field that was packed
! using the complex packing algorithm for spherical harmonic data as
! defined in the GRIB2 documention,
! using info from the GRIB2 Data Representation Template 5.51.
!
! PROGRAM HISTORY LOG:
! 2002-12-19 Gilbert
!
! USAGE: CALL specunpack(cpack,len,idrstmpl,ndpts,JJ,KK,MM,fld)
! INPUT ARGUMENT LIST:
! cpack - The packed data field (character*1 array)
! len - length of packed field cpack().
! idrstmpl - Contains the array of values for Data Representation
! Template 5.51
! ndpts - The number of data values to unpack
! JJ - J - pentagonal resolution parameter
! KK - K - pentagonal resolution parameter
! MM - M - pentagonal resolution parameter
!
! OUTPUT ARGUMENT LIST:
! fld() - Contains the unpacked data values
!
! REMARKS: None
!
! ATTRIBUTES:
! LANGUAGE: XL Fortran 90
! MACHINE: IBM SP
!
!$$$
character(len=1),intent(in) :: cpack(len)
integer,intent(in) :: ndpts,len,JJ,KK,MM
integer,intent(in) :: idrstmpl(*)
real,intent(out) :: fld(ndpts)
integer :: ifld(ndpts),Ts
integer(4) :: ieee
real :: ref,bscale,dscale,unpk(ndpts)
real,allocatable :: pscale(:)
ieee = idrstmpl(1)
call rdieee
(ieee,ref,1)
bscale = 2.0**real(idrstmpl(2))
dscale = 10.0**real(-idrstmpl(3))
nbits = idrstmpl(4)
Js=idrstmpl(6)
Ks=idrstmpl(7)
Ms=idrstmpl(8)
Ts=idrstmpl(9)
if (idrstmpl(10).eq.1) then ! unpacked floats are 32-bit IEEE
!call gbytes(cpack,ifld,0,32,0,Ts)
call rdieee
(cpack,unpk,Ts) ! read IEEE unpacked floats
iofst=32*Ts
call gbytes
(cpack,ifld,iofst,nbits,0,ndpts-Ts) ! unpack scaled data
!
! Calculate Laplacian scaling factors for each possible wave number.
!
allocate(pscale(JJ+MM))
tscale=real(idrstmpl(5))*1E-6
do n=Js,JJ+MM
pscale(n)=real(n*(n+1))**(-tscale)
enddo
!
! Assemble spectral coeffs back to original order.
!
inc=1
incu=1
incp=1
do m=0,MM
Nm=JJ ! triangular or trapezoidal
if ( KK .eq. JJ+MM ) Nm=JJ+m ! rhombodial
Ns=Js ! triangular or trapezoidal
if ( Ks .eq. Js+Ms ) Ns=Js+m ! rhombodial
do n=m,Nm
if (n.le.Ns .AND. m.le.Ms) then ! grab unpacked value
fld(inc)=unpk(incu) ! real part
fld(inc+1)=unpk(incu+1) ! imaginary part
inc=inc+2
incu=incu+2
else ! Calc coeff from packed value
fld(inc)=((real(ifld(incp))*bscale)+ref)*
& dscale*pscale(n) ! real part
fld(inc+1)=((real(ifld(incp+1))*bscale)+ref)*
& dscale*pscale(n) ! imaginary part
inc=inc+2
incp=incp+2
endif
enddo
enddo
deallocate(pscale)
else
print *,'specunpack: Cannot handle 64 or 128-bit floats.'
fld=0.0
return
endif
return
end