source: trunk/WRF.COMMON/WRFV3/external/io_grib2/g2lib/cmplxpack.F @ 3567

Last change on this file since 3567 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size

File size: 2.7 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.