external/io_grib2/g2lib/drstemplates.F

   1       module drstemplates
   2 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 !                .      .    .                                       .
   4 ! MODULE:    drstemplates
   5 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-04-03
   6 !
   7 ! ABSTRACT: This Fortran Module contains info on all the available
   8 !   GRIB2 Data Representation Templates used in Section 5 (DRS).
   9 !   Each Template has three parts: The number of entries in the template
  10 !   (mapgridlen);  A map of the template (mapgrid), which contains the
  11 !   number of octets in which to pack each of the template values; and
  12 !   a logical value (needext) that indicates whether the Template needs
  13 !   to be extended.  In some cases the number of entries in a template
  14 !   can vary depending upon values specified in the "static" part of
  15 !   the template.  ( See Template 5.1 as an example )
  16 !
  17 !   This module also contains two subroutines.  Subroutine getdrstemplate
  18 !   returns the octet map for a specified Template number, and
  19 !   subroutine extdrstemplate will calculate the extended octet map
  20 !   of an appropriate template given values for the "static" part of the
  21 !   template.  See docblocks below for the arguments and usage of these
  22 !   routines.
  23 !
  24 !   NOTE:  Array mapgrid contains the number of octets in which the
  25 !   corresponding template values will be stored.  A negative value in
  26 !   mapgrid is used to indicate that the corresponding template entry can
  27 !   contain negative values.  This information is used later when packing
  28 !   (or unpacking) the template data values.  Negative data values in GRIB
  29 !   are stored with the left most bit set to one, and a negative number
  30 !   of octets value in mapgrid() indicates that this possibility should
  31 !   be considered.  The number of octets used to store the data value
  32 !   in this case would be the absolute value of the negative value in
  33 !   mapgrid().
  34 !
  35 !
  36 ! PROGRAM HISTORY LOG:
  37 ! 2000-05-11  Gilbert
  38 ! 2002-12-11  Gilbert - Added templates for JPEG2000 and PNG encoding
  39 !
  40 ! USAGE:    use drstemplates
  41 !
  42 ! ATTRIBUTES:
  43 !   LANGUAGE: Fortran 90
  44 !   MACHINE:  IBM SP
  45 !
  46 !$$$
  47
  48       integer,parameter :: MAXLEN=200,MAXTEMP=9
  49
  50       type drstemplate
  51           integer :: template_num
  52           integer :: mapdrslen
  53           integer,dimension(MAXLEN) :: mapdrs
  54           logical :: needext
  55       end type drstemplate
  56
  57       type(drstemplate),dimension(MAXTEMP) :: templates
  58
  59       data templates(1)%template_num /0/     !  Simple Packing
  60       data templates(1)%mapdrslen /5/
  61       data templates(1)%needext /.false./
  62       data (templates(1)%mapdrs(j),j=1,5)
  63      &                             /4,-2,-2,1,1/
  64
  65       data templates(2)%template_num /2/     !  Complex Packing
  66       data templates(2)%mapdrslen /16/
  67       data templates(2)%needext /.false./
  68       data (templates(2)%mapdrs(j),j=1,16)
  69      &                        /4,-2,-2,1,1,1,1,4,4,4,1,1,4,1,4,1/
  70
  71       data templates(3)%template_num /3/     !  Complex Packing - Spatial Diff
  72       data templates(3)%mapdrslen /18/
  73       data templates(3)%needext /.false./
  74       data (templates(3)%mapdrs(j),j=1,18)
  75      &                        /4,-2,-2,1,1,1,1,4,4,4,1,1,4,1,4,1,1,1/
  76
  77       data templates(4)%template_num /50/     !  Simple Packing - Spectral Data
  78       data templates(4)%mapdrslen /5/
  79       data templates(4)%needext /.false./
  80       data (templates(4)%mapdrs(j),j=1,5)
  81      &                         /4,-2,-2,1,4/
  82
  83       data templates(5)%template_num /51/    !  Complex Packing - Spectral Data
  84       data templates(5)%mapdrslen /10/
  85       data templates(5)%needext /.false./
  86       data (templates(5)%mapdrs(j),j=1,10)
  87      &                         /4,-2,-2,1,-4,2,2,2,4,1/
  88
  89       data templates(6)%template_num /40000/     !  JPEG2000 Encoding
  90       data templates(6)%mapdrslen /7/
  91       data templates(6)%needext /.false./
  92       data (templates(6)%mapdrs(j),j=1,7)
  93      &                             /4,-2,-2,1,1,1,1/
  94
  95       data templates(7)%template_num /40010/     !  PNG Encoding
  96       data templates(7)%mapdrslen /5/
  97       data templates(7)%needext /.false./
  98       data (templates(7)%mapdrs(j),j=1,5)
  99      &                             /4,-2,-2,1,1/
 100
 101       data templates(8)%template_num /40/     !  JPEG2000 Encoding
 102       data templates(8)%mapdrslen /7/
 103       data templates(8)%needext /.false./
 104       data (templates(8)%mapdrs(j),j=1,7)
 105      &                             /4,-2,-2,1,1,1,1/
 106
 107       data templates(9)%template_num /41/     !  PNG Encoding
 108       data templates(9)%mapdrslen /5/
 109       data templates(9)%needext /.false./
 110       data (templates(9)%mapdrs(j),j=1,5)
 111      &                             /4,-2,-2,1,1/
 112
 113 !      data templates(5)%template_num /1/      !  Simple Packing - Matrix
 114 !      data templates(5)%mapdrslen /15/
 115 !      data templates(5)%needext /.true./
 116 !      data (templates(5)%mapdrs(j),j=1,15)
 117 !     &                        /4,-2,-2,1,1,1,4,2,2,1,1,1,1,1,1/
 118
 119
 120       contains
 121
 122          integer function getdrsindex(number)
 123 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 124 !                .      .    .                                       .
 125 ! SUBPROGRAM:    getdrsindex
 126 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-06-28
 127 !
 128 ! ABSTRACT: This function returns the index of specified Data
 129 !   Representation Template 5.NN (NN=number) in array templates.
 130 !
 131 ! PROGRAM HISTORY LOG:
 132 ! 2001-06-28  Gilbert
 133 !
 134 ! USAGE:    index=getdrsindex(number)
 135 !   INPUT ARGUMENT LIST:
 136 !     number   - NN, indicating the number of the Data Representation
 137 !                Template 5.NN that is being requested.
 138 !
 139 ! RETURNS:  Index of DRT 5.NN in array templates, if template exists.
 140 !           = -1, otherwise.
 141 !
 142 ! REMARKS: None
 143 !
 144 ! ATTRIBUTES:
 145 !   LANGUAGE: Fortran 90
 146 !   MACHINE:  IBM SP
 147 !
 148 !$$$
 149            integer,intent(in) :: number
 150
 151            getdrsindex=-1
 152
 153            do j=1,MAXTEMP
 154               if (number.eq.templates(j)%template_num) then
 155                  getdrsindex=j
 156                  return
 157               endif
 158            enddo
 159
 160          end function
 161
 162
 163          subroutine getdrstemplate(number,nummap,map,needext,iret)
 164 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 165 !                .      .    .                                       .
 166 ! SUBPROGRAM:    getdrstemplate
 167 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-11
 168 !
 169 ! ABSTRACT: This subroutine returns DRS template information for a
 170 !   specified Data Representation Template 5.NN.
 171 !   The number of entries in the template is returned along with a map
 172 !   of the number of octets occupied by each entry.  Also, a flag is
 173 !   returned to indicate whether the template would need to be extended.
 174 !
 175 ! PROGRAM HISTORY LOG:
 176 ! 2000-05-11  Gilbert
 177 !
 178 ! USAGE:    CALL getdrstemplate(number,nummap,map,needext,iret)
 179 !   INPUT ARGUMENT LIST:
 180 !     number   - NN, indicating the number of the Data Representation
 181 !                Template 5.NN that is being requested.
 182 !
 183 !   OUTPUT ARGUMENT LIST:
 184 !     nummap   - Number of entries in the Template
 185 !     map()    - An array containing the number of octets that each
 186 !                template entry occupies when packed up into the DRS.
 187 !     needext  - Logical variable indicating whether the Data Representation
 188 !                Template has to be extended.
 189 !     ierr     - Error return code.
 190 !                0 = no error
 191 !                1 = Undefined Data Representation Template number.
 192 !
 193 ! REMARKS: None
 194 !
 195 ! ATTRIBUTES:
 196 !   LANGUAGE: Fortran 90
 197 !   MACHINE:  IBM SP
 198 !
 199 !$$$
 200            integer,intent(in) :: number
 201            integer,intent(out) :: nummap,map(*),iret
 202            logical,intent(out) :: needext
 203
 204            iret=0
 205
 206            index=getdrsindex(number)
 207
 208            if (index.ne.-1) then
 209               nummap=templates(index)%mapdrslen
 210               needext=templates(index)%needext
 211               map(1:nummap)=templates(index)%mapdrs(1:nummap)
 212            else
 213              nummap=0
 214              needext=.false.
 215              print *,'getdrstemplate: DRS Template ',number,
 216      &               ' not defined.'
 217              iret=1
 218            endif
 219
 220          end subroutine
 221
 222          subroutine extdrstemplate(number,list,nummap,map)
 223 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 224 !                .      .    .                                       .
 225 ! SUBPROGRAM:    extdrstemplate
 226 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-11
 227 !
 228 ! ABSTRACT: This subroutine generates the remaining octet map for a
 229 !   given Data Representation Template, if required.  Some Templates can
 230 !   vary depending on data values given in an earlier part of the
 231 !   Template, and it is necessary to know some of the earlier entry
 232 !   values to generate the full octet map of the Template.
 233 !
 234 ! PROGRAM HISTORY LOG:
 235 ! 2000-05-11  Gilbert
 236 !
 237 ! USAGE:    CALL extdrstemplate(number,list,nummap,map)
 238 !   INPUT ARGUMENT LIST:
 239 !     number   - NN, indicating the number of the Data Representation
 240 !                Template 5.NN that is being requested.
 241 !     list()   - The list of values for each entry in the
 242 !                the Data Representation Template 5.NN.
 243 !
 244 !   OUTPUT ARGUMENT LIST:
 245 !     nummap   - Number of entries in the Template
 246 !     map()    - An array containing the number of octets that each
 247 !                template entry occupies when packed up into the GDS.
 248 !
 249 ! ATTRIBUTES:
 250 !   LANGUAGE: Fortran 90
 251 !   MACHINE:  IBM SP
 252 !
 253 !$$$
 254            integer,intent(in) :: number,list(*)
 255            integer,intent(out) :: nummap,map(*)
 256
 257            index=getdrsindex(number)
 258            if (index.eq.-1) return
 259
 260            if ( .not. templates(index)%needext ) return
 261            nummap=templates(index)%mapdrslen
 262            map(1:nummap)=templates(index)%mapdrs(1:nummap)
 263
 264            if ( number.eq.1 ) then
 265               N=list(11)+list(13)
 266               do i=1,N
 267                 map(nummap+i)=4
 268               enddo
 269               nummap=nummap+N
 270            endif
 271
 272          end subroutine
 273
 274       end module
 275
 276
 277