subroutine cmplxpack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack) 1,2
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! SUBPROGRAM: cmplxpack
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-08-27
!
! ABSTRACT: This subroutine packs up a data field using a complex
! packing algorithm as defined in the GRIB2 documention. It
! supports GRIB2 complex packing templates with or without
! spatial differences (i.e. DRTs 5.2 and 5.3).
! It also fills in GRIB2 Data Representation Template 5.2 or 5.3
! with the appropriate values.
!
! PROGRAM HISTORY LOG:
! 2004-08-27 Gilbert
!
! USAGE: CALL cmplxpack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
! INPUT ARGUMENT LIST:
! fld() - Contains the data values to pack
! ndpts - The number of data values in array fld()
! idrsnum - Data Representation Template number 5.N
! Must equal 2 or 3.
! idrstmpl - Contains the array of values for Data Representation
! Template 5.2 or 5.3
! (1) = Reference value - ignored on input
! (2) = Binary Scale Factor
! (3) = Decimal Scale Factor
! .
! .
! (7) = Missing value management
! (8) = Primary missing value
! (9) = Secondary missing value
! .
! .
! (17) = Order of Spatial Differencing ( 1 or 2 )
! .
! .
!
! OUTPUT ARGUMENT LIST:
! idrstmpl - Contains the array of values for Data Representation
! Template 5.3
! (1) = Reference value - set by compack routine.
! (2) = Binary Scale Factor - unchanged from input
! (3) = Decimal Scale Factor - unchanged from input
! .
! .
! cpack - The packed data field (character*1 array)
! lcpack - length of packed field cpack().
!
! REMARKS: None
!
! ATTRIBUTES:
! LANGUAGE: XL Fortran 90
! MACHINE: IBM SP
!
!$$$
integer,intent(in) :: ndpts,idrsnum
real,intent(in) :: fld(ndpts)
character(len=1),intent(out) :: cpack(*)
integer,intent(inout) :: idrstmpl(*)
integer,intent(out) :: lcpack
if ( idrstmpl(7) .eq. 0 ) then ! No internal missing values
call compack
(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
elseif ( idrstmpl(7).eq.1 .OR. idrstmpl(7).eq.2) then
call misspack
(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
else
print *,'cmplxpack: Don:t recognize Missing value option.'
lcpack=-1
endif
return
end