ungrib/src/ngl/g2/cmplxpack.f

   1       subroutine cmplxpack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
   2 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 !                .      .    .                                       .
   4 ! SUBPROGRAM:    cmplxpack
   5 !   PRGMMR: Gilbert          ORG: W/NP11    DATE: 2004-08-27
   6 !
   7 ! ABSTRACT: This subroutine packs up a data field using a complex
   8 !   packing algorithm as defined in the GRIB2 documention.  It
   9 !   supports GRIB2 complex packing templates with or without
  10 !   spatial differences (i.e. DRTs 5.2 and 5.3).
  11 !   It also fills in GRIB2 Data Representation Template 5.2 or 5.3
  12 !   with the appropriate values.
  13 !
  14 ! PROGRAM HISTORY LOG:
  15 ! 2004-08-27  Gilbert
  16 !
  17 ! USAGE:    CALL cmplxpack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
  18 !   INPUT ARGUMENT LIST:
  19 !     fld()    - Contains the data values to pack
  20 !     ndpts    - The number of data values in array fld()
  21 !     idrsnum  - Data Representation Template number 5.N
  22 !                Must equal 2 or 3.
  23 !     idrstmpl - Contains the array of values for Data Representation
  24 !                Template 5.2 or 5.3
  25 !                (1) = Reference value - ignored on input
  26 !                (2) = Binary Scale Factor
  27 !                (3) = Decimal Scale Factor
  28 !                    .
  29 !                    .
  30 !                (7) = Missing value management
  31 !                (8) = Primary missing value
  32 !                (9) = Secondary missing value
  33 !                    .
  34 !                    .
  35 !               (17) = Order of Spatial Differencing  ( 1 or 2 )
  36 !                    .
  37 !                    .
  38 !
  39 !   OUTPUT ARGUMENT LIST:
  40 !     idrstmpl - Contains the array of values for Data Representation
  41 !                Template 5.3
  42 !                (1) = Reference value - set by compack routine.
  43 !                (2) = Binary Scale Factor - unchanged from input
  44 !                (3) = Decimal Scale Factor - unchanged from input
  45 !                    .
  46 !                    .
  47 !     cpack    - The packed data field (character*1 array)
  48 !     lcpack   - length of packed field cpack().
  49 !
  50 ! REMARKS: None
  51 !
  52 ! ATTRIBUTES:
  53 !   LANGUAGE: XL Fortran 90
  54 !   MACHINE:  IBM SP
  55 !
  56 !$$$
  57
  58       integer,intent(in) :: ndpts,idrsnum
  59       real,intent(in) :: fld(ndpts)
  60       character(len=1),intent(out) :: cpack(*)
  61       integer,intent(inout) :: idrstmpl(*)
  62       integer,intent(out) :: lcpack
  63
  64
  65
  66       if ( idrstmpl(7) .eq. 0 ) then       ! No internal missing values
  67          call compack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
  68       elseif ( idrstmpl(7).eq.1 .OR. idrstmpl(7).eq.2) then
  69          call misspack(fld,ndpts,idrsnum,idrstmpl,cpack,lcpack)
  70       else
  71          print *,'cmplxpack: Don:t recognize Missing value option.'
  72          lcpack=-1
  73       endif
  74
  75       return
  76       end