| 1 | subroutine gf_unpack3(cgrib,lcgrib,iofst,igds,igdstmpl, |
|---|
| 2 | & mapgridlen,ideflist,idefnum,ierr) |
|---|
| 3 | !$$$ SUBPROGRAM DOCUMENTATION BLOCK |
|---|
| 4 | ! . . . . |
|---|
| 5 | ! SUBPROGRAM: gf_unpack3 |
|---|
| 6 | ! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-26 |
|---|
| 7 | ! |
|---|
| 8 | ! ABSTRACT: This subroutine unpacks Section 3 (Grid Definition Section) |
|---|
| 9 | ! starting at octet 6 of that Section. |
|---|
| 10 | ! |
|---|
| 11 | ! PROGRAM HISTORY LOG: |
|---|
| 12 | ! 2000-05-26 Gilbert |
|---|
| 13 | ! 2002-01-24 Gilbert - Changed to dynamically allocate arrays |
|---|
| 14 | ! and to pass pointers to those arrays through |
|---|
| 15 | ! the argument list. |
|---|
| 16 | ! |
|---|
| 17 | ! USAGE: CALL gf_unpack3(cgrib,lcgrib,lensec,iofst,igds,igdstmpl, |
|---|
| 18 | ! & mapgridlen,ideflist,idefnum,ierr) |
|---|
| 19 | ! INPUT ARGUMENT LIST: |
|---|
| 20 | ! cgrib - Character array that contains the GRIB2 message |
|---|
| 21 | ! lcgrib - Length (in bytes) of GRIB message array cgrib. |
|---|
| 22 | ! iofst - Bit offset of the beginning of Section 3. |
|---|
| 23 | ! |
|---|
| 24 | ! OUTPUT ARGUMENT LIST: |
|---|
| 25 | ! iofst - Bit offset at the end of Section 3, returned. |
|---|
| 26 | ! igds - Contains information read from the appropriate GRIB Grid |
|---|
| 27 | ! Definition Section 3 for the field being returned. |
|---|
| 28 | ! Must be dimensioned >= 5. |
|---|
| 29 | ! igds(1)=Source of grid definition (see Code Table 3.0) |
|---|
| 30 | ! igds(2)=Number of grid points in the defined grid. |
|---|
| 31 | ! igds(3)=Number of octets needed for each |
|---|
| 32 | ! additional grid points definition. |
|---|
| 33 | ! Used to define number of |
|---|
| 34 | ! points in each row ( or column ) for |
|---|
| 35 | ! non-regular grids. |
|---|
| 36 | ! = 0, if using regular grid. |
|---|
| 37 | ! igds(4)=Interpretation of list for optional points |
|---|
| 38 | ! definition. (Code Table 3.11) |
|---|
| 39 | ! igds(5)=Grid Definition Template Number (Code Table 3.1) |
|---|
| 40 | ! igdstmpl - Pointer to integer array containing the data values for |
|---|
| 41 | ! the specified Grid Definition |
|---|
| 42 | ! Template ( NN=igds(5) ). Each element of this integer |
|---|
| 43 | ! array contains an entry (in the order specified) of Grid |
|---|
| 44 | ! Defintion Template 3.NN |
|---|
| 45 | ! mapgridlen- Number of elements in igdstmpl(). i.e. number of entries |
|---|
| 46 | ! in Grid Defintion Template 3.NN ( NN=igds(5) ). |
|---|
| 47 | ! ideflist - (Used if igds(3) .ne. 0) Pointer to integer array containing |
|---|
| 48 | ! the number of grid points contained in each row ( or column ). |
|---|
| 49 | ! (part of Section 3) |
|---|
| 50 | ! idefnum - (Used if igds(3) .ne. 0) The number of entries |
|---|
| 51 | ! in array ideflist. i.e. number of rows ( or columns ) |
|---|
| 52 | ! for which optional grid points are defined. |
|---|
| 53 | ! ierr - Error return code. |
|---|
| 54 | ! 0 = no error |
|---|
| 55 | ! 5 = "GRIB" message contains an undefined Grid Definition |
|---|
| 56 | ! Template. |
|---|
| 57 | ! 6 = memory allocation error |
|---|
| 58 | ! |
|---|
| 59 | ! REMARKS: Uses Fortran 90 module gridtemplates and module re_alloc. |
|---|
| 60 | ! |
|---|
| 61 | ! ATTRIBUTES: |
|---|
| 62 | ! LANGUAGE: Fortran 90 |
|---|
| 63 | ! MACHINE: IBM SP |
|---|
| 64 | ! |
|---|
| 65 | !$$$ |
|---|
| 66 | |
|---|
| 67 | use gridtemplates |
|---|
| 68 | use re_alloc ! needed for subroutine realloc |
|---|
| 69 | |
|---|
| 70 | character(len=1),intent(in) :: cgrib(lcgrib) |
|---|
| 71 | integer,intent(in) :: lcgrib |
|---|
| 72 | integer,intent(inout) :: iofst |
|---|
| 73 | integer,pointer,dimension(:) :: igdstmpl,ideflist |
|---|
| 74 | integer,intent(out) :: igds(5) |
|---|
| 75 | integer,intent(out) :: ierr,idefnum |
|---|
| 76 | |
|---|
| 77 | integer,allocatable :: mapgrid(:) |
|---|
| 78 | integer :: mapgridlen,ibyttem |
|---|
| 79 | logical needext |
|---|
| 80 | |
|---|
| 81 | ierr=0 |
|---|
| 82 | nullify(igdstmpl,ideflist) |
|---|
| 83 | |
|---|
| 84 | call g2lib_gbyte(cgrib,lensec,iofst,32) ! Get Length of Section |
|---|
| 85 | iofst=iofst+32 |
|---|
| 86 | iofst=iofst+8 ! skip section number |
|---|
| 87 | |
|---|
| 88 | call g2lib_gbyte(cgrib,igds(1),iofst,8) ! Get source of Grid def. |
|---|
| 89 | iofst=iofst+8 |
|---|
| 90 | call g2lib_gbyte(cgrib,igds(2),iofst,32) ! Get number of grid pts. |
|---|
| 91 | iofst=iofst+32 |
|---|
| 92 | call g2lib_gbyte(cgrib,igds(3),iofst,8) ! Get num octets for opt. list |
|---|
| 93 | iofst=iofst+8 |
|---|
| 94 | call g2lib_gbyte(cgrib,igds(4),iofst,8) ! Get interpret. for opt. list |
|---|
| 95 | iofst=iofst+8 |
|---|
| 96 | call g2lib_gbyte(cgrib,igds(5),iofst,16) ! Get Grid Def Template num. |
|---|
| 97 | iofst=iofst+16 |
|---|
| 98 | ! if (igds(1).eq.0) then |
|---|
| 99 | if (igds(1).eq.0.OR.igds(1).eq.255) then ! FOR ECMWF TEST ONLY |
|---|
| 100 | allocate(mapgrid(lensec)) |
|---|
| 101 | ! Get Grid Definition Template |
|---|
| 102 | call getgridtemplate(igds(5),mapgridlen,mapgrid,needext, |
|---|
| 103 | & iret) |
|---|
| 104 | if (iret.ne.0) then |
|---|
| 105 | ierr=5 |
|---|
| 106 | if( allocated(mapgrid) ) deallocate(mapgrid) |
|---|
| 107 | return |
|---|
| 108 | endif |
|---|
| 109 | else |
|---|
| 110 | ! igdstmpl=-1 |
|---|
| 111 | mapgridlen=0 |
|---|
| 112 | needext=.false. |
|---|
| 113 | endif |
|---|
| 114 | ! |
|---|
| 115 | ! Unpack each value into array igdstmpl from the |
|---|
| 116 | ! the appropriate number of octets, which are specified in |
|---|
| 117 | ! corresponding entries in array mapgrid. |
|---|
| 118 | ! |
|---|
| 119 | istat=0 |
|---|
| 120 | if (mapgridlen.gt.0) allocate(igdstmpl(mapgridlen),stat=istat) |
|---|
| 121 | if (istat.ne.0) then |
|---|
| 122 | ierr=6 |
|---|
| 123 | nullify(igdstmpl) |
|---|
| 124 | if( allocated(mapgrid) ) deallocate(mapgrid) |
|---|
| 125 | return |
|---|
| 126 | endif |
|---|
| 127 | ibyttem=0 |
|---|
| 128 | do i=1,mapgridlen |
|---|
| 129 | nbits=iabs(mapgrid(i))*8 |
|---|
| 130 | if ( mapgrid(i).ge.0 ) then |
|---|
| 131 | call g2lib_gbyte(cgrib,igdstmpl(i),iofst,nbits) |
|---|
| 132 | else |
|---|
| 133 | call g2lib_gbyte(cgrib,isign,iofst,1) |
|---|
| 134 | call g2lib_gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1) |
|---|
| 135 | if (isign.eq.1) igdstmpl(i)=-igdstmpl(i) |
|---|
| 136 | endif |
|---|
| 137 | iofst=iofst+nbits |
|---|
| 138 | ibyttem=ibyttem+iabs(mapgrid(i)) |
|---|
| 139 | enddo |
|---|
| 140 | ! |
|---|
| 141 | ! Check to see if the Grid Definition Template needs to be |
|---|
| 142 | ! extended. |
|---|
| 143 | ! The number of values in a specific template may vary |
|---|
| 144 | ! depending on data specified in the "static" part of the |
|---|
| 145 | ! template. |
|---|
| 146 | ! |
|---|
| 147 | if ( needext ) then |
|---|
| 148 | call extgridtemplate(igds(5),igdstmpl,newmapgridlen,mapgrid) |
|---|
| 149 | ! Unpack the rest of the Grid Definition Template |
|---|
| 150 | call realloc(igdstmpl,mapgridlen,newmapgridlen,istat) |
|---|
| 151 | do i=mapgridlen+1,newmapgridlen |
|---|
| 152 | nbits=iabs(mapgrid(i))*8 |
|---|
| 153 | if ( mapgrid(i).ge.0 ) then |
|---|
| 154 | call g2lib_gbyte(cgrib,igdstmpl(i),iofst,nbits) |
|---|
| 155 | else |
|---|
| 156 | call g2lib_gbyte(cgrib,isign,iofst,1) |
|---|
| 157 | call g2lib_gbyte(cgrib,igdstmpl(i),iofst+1,nbits-1) |
|---|
| 158 | if (isign.eq.1) igdstmpl(i)=-igdstmpl(i) |
|---|
| 159 | endif |
|---|
| 160 | iofst=iofst+nbits |
|---|
| 161 | ibyttem=ibyttem+iabs(mapgrid(i)) |
|---|
| 162 | enddo |
|---|
| 163 | mapgridlen=newmapgridlen |
|---|
| 164 | endif |
|---|
| 165 | if( allocated(mapgrid) ) deallocate(mapgrid) |
|---|
| 166 | ! |
|---|
| 167 | ! Unpack optional list of numbers defining number of points |
|---|
| 168 | ! in each row or column, if included. This is used for non regular |
|---|
| 169 | ! grids. |
|---|
| 170 | ! |
|---|
| 171 | if ( igds(3).ne.0 ) then |
|---|
| 172 | nbits=igds(3)*8 |
|---|
| 173 | idefnum=(lensec-14-ibyttem)/igds(3) |
|---|
| 174 | istat=0 |
|---|
| 175 | if (idefnum.gt.0) allocate(ideflist(idefnum),stat=istat) |
|---|
| 176 | if (istat.ne.0) then |
|---|
| 177 | ierr=6 |
|---|
| 178 | nullify(ideflist) |
|---|
| 179 | return |
|---|
| 180 | endif |
|---|
| 181 | call g2lib_gbytes(cgrib,ideflist,iofst,nbits,0,idefnum) |
|---|
| 182 | iofst=iofst+(nbits*idefnum) |
|---|
| 183 | else |
|---|
| 184 | idefnum=0 |
|---|
| 185 | nullify(ideflist) |
|---|
| 186 | endif |
|---|
| 187 | |
|---|
| 188 | return ! End of Section 3 processing |
|---|
| 189 | end |
|---|
