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 |
---|