[2759] | 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 |
---|