| 1 | subroutine gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl, |
|---|
| 2 | & idrsnum,idrstmpl,ndpts,fld,ierr) |
|---|
| 3 | !$$$ SUBPROGRAM DOCUMENTATION BLOCK |
|---|
| 4 | ! . . . . |
|---|
| 5 | ! SUBPROGRAM: gf_unpack7 |
|---|
| 6 | ! PRGMMR: Gilbert ORG: W/NP11 DATE: 2002-01-24 |
|---|
| 7 | ! |
|---|
| 8 | ! ABSTRACT: This subroutine unpacks GRIB2 Section 7 (Data Section). |
|---|
| 9 | ! |
|---|
| 10 | ! PROGRAM HISTORY LOG: |
|---|
| 11 | ! 2002-01-24 Gilbert |
|---|
| 12 | ! 2002-12-17 Gilbert - Added support for new templates using |
|---|
| 13 | ! PNG and JPEG2000 algorithms/templates. |
|---|
| 14 | ! 2004-12-29 Gilbert - Added check on comunpack return code. |
|---|
| 15 | ! |
|---|
| 16 | ! USAGE: CALL gf_unpack7(cgrib,lcgrib,iofst,igdsnum,igdstmpl, |
|---|
| 17 | ! & idrsnum,idrstmpl,ndpts,fld,ierr) |
|---|
| 18 | ! INPUT ARGUMENT LIST: |
|---|
| 19 | ! cgrib - Character array that contains the GRIB2 message |
|---|
| 20 | ! lcgrib - Length (in bytes) of GRIB message array cgrib. |
|---|
| 21 | ! iofst - Bit offset of the beginning of Section 7. |
|---|
| 22 | ! igdsnum - Grid Definition Template Number ( see Code Table 3.0) |
|---|
| 23 | ! (Only required to unpack DRT 5.51) |
|---|
| 24 | ! igdstmpl - Pointer to an integer array containing the data values for |
|---|
| 25 | ! the specified Grid Definition |
|---|
| 26 | ! Template ( N=igdsnum ). Each element of this integer |
|---|
| 27 | ! array contains an entry (in the order specified) of Grid |
|---|
| 28 | ! Definition Template 3.N |
|---|
| 29 | ! (Only required to unpack DRT 5.51) |
|---|
| 30 | ! idrsnum - Data Representation Template Number ( see Code Table 5.0) |
|---|
| 31 | ! idrstmpl - Pointer to an integer array containing the data values for |
|---|
| 32 | ! the specified Data Representation |
|---|
| 33 | ! Template ( N=idrsnum ). Each element of this integer |
|---|
| 34 | ! array contains an entry (in the order specified) of Data |
|---|
| 35 | ! Representation Template 5.N |
|---|
| 36 | ! ndpts - Number of data points unpacked and returned. |
|---|
| 37 | ! |
|---|
| 38 | ! OUTPUT ARGUMENT LIST: |
|---|
| 39 | ! iofst - Bit offset at the end of Section 7, returned. |
|---|
| 40 | ! fld() - Pointer to a real array containing the unpacked data field. |
|---|
| 41 | ! ierr - Error return code. |
|---|
| 42 | ! 0 = no error |
|---|
| 43 | ! 4 = Unrecognized Data Representation Template |
|---|
| 44 | ! 5 = One of GDT 3.50 through 3.53 required to unpack DRT 5.51 |
|---|
| 45 | ! 6 = memory allocation error |
|---|
| 46 | ! 7 = corrupt section 7. |
|---|
| 47 | ! |
|---|
| 48 | ! REMARKS: None |
|---|
| 49 | ! |
|---|
| 50 | ! ATTRIBUTES: |
|---|
| 51 | ! LANGUAGE: Fortran 90 |
|---|
| 52 | ! MACHINE: IBM SP |
|---|
| 53 | ! |
|---|
| 54 | !$$$ |
|---|
| 55 | |
|---|
| 56 | character(len=1),intent(in) :: cgrib(lcgrib) |
|---|
| 57 | integer,intent(in) :: lcgrib,ndpts,igdsnum,idrsnum |
|---|
| 58 | integer,intent(inout) :: iofst |
|---|
| 59 | integer,pointer,dimension(:) :: igdstmpl,idrstmpl |
|---|
| 60 | integer,intent(out) :: ierr |
|---|
| 61 | real,pointer,dimension(:) :: fld |
|---|
| 62 | |
|---|
| 63 | |
|---|
| 64 | ierr=0 |
|---|
| 65 | nullify(fld) |
|---|
| 66 | |
|---|
| 67 | call g2lib_gbyte(cgrib,lensec,iofst,32) ! Get Length of Section |
|---|
| 68 | iofst=iofst+32 |
|---|
| 69 | iofst=iofst+8 ! skip section number |
|---|
| 70 | |
|---|
| 71 | ipos=(iofst/8)+1 |
|---|
| 72 | istat=0 |
|---|
| 73 | allocate(fld(ndpts),stat=istat) |
|---|
| 74 | if (istat.ne.0) then |
|---|
| 75 | ierr=6 |
|---|
| 76 | return |
|---|
| 77 | endif |
|---|
| 78 | |
|---|
| 79 | if (idrsnum.eq.0) then |
|---|
| 80 | call simunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld) |
|---|
| 81 | elseif (idrsnum.eq.2.or.idrsnum.eq.3) then |
|---|
| 82 | call comunpack(cgrib(ipos),lensec-5,lensec,idrsnum,idrstmpl, |
|---|
| 83 | & ndpts,fld,ier) |
|---|
| 84 | if ( ier .NE. 0 ) then |
|---|
| 85 | ierr=7 |
|---|
| 86 | return |
|---|
| 87 | endif |
|---|
| 88 | elseif (idrsnum.eq.50) then ! Spectral simple |
|---|
| 89 | call simunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts-1, |
|---|
| 90 | & fld(2)) |
|---|
| 91 | ieee=idrstmpl(5) |
|---|
| 92 | call rdieee(ieee,fld(1),1) |
|---|
| 93 | elseif (idrsnum.eq.51) then ! Spectral complex |
|---|
| 94 | if (igdsnum.ge.50.AND.igdsnum.le.53) then |
|---|
| 95 | call specunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts, |
|---|
| 96 | & igdstmpl(1),igdstmpl(2),igdstmpl(3),fld) |
|---|
| 97 | else |
|---|
| 98 | print *,'gf_unpack7: Cannot use GDT 3.',igdsnum, |
|---|
| 99 | & ' to unpack Data Section 5.51.' |
|---|
| 100 | ierr=5 |
|---|
| 101 | nullify(fld) |
|---|
| 102 | return |
|---|
| 103 | endif |
|---|
| 104 | #ifdef USE_JPEG2000 |
|---|
| 105 | elseif (idrsnum.eq.40 .OR. idrsnum.eq.40000) then |
|---|
| 106 | call jpcunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld) |
|---|
| 107 | #endif /* USE_JPEG2000 */ |
|---|
| 108 | #ifdef USE_PNG |
|---|
| 109 | elseif (idrsnum.eq.41 .OR. idrsnum.eq.40010) then |
|---|
| 110 | call pngunpack(cgrib(ipos),lensec-5,idrstmpl,ndpts,fld) |
|---|
| 111 | #endif /* USE_PNG */ |
|---|
| 112 | else |
|---|
| 113 | print *,'gf_unpack7: Data Representation Template ',idrsnum, |
|---|
| 114 | & ' not yet implemented.' |
|---|
| 115 | ierr=4 |
|---|
| 116 | nullify(fld) |
|---|
| 117 | return |
|---|
| 118 | endif |
|---|
| 119 | |
|---|
| 120 | iofst=iofst+(8*lensec) |
|---|
| 121 | |
|---|
| 122 | return ! End of Section 7 processing |
|---|
| 123 | end |
|---|
| 124 | |
|---|