external/io_grib2/g2lib/gridtemplates.F

   1       module gridtemplates
   2 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 !                .      .    .                                       .
   4 ! MODULE:    gridtemplates
   5 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-09
   6 !
   7 ! ABSTRACT: This Fortran Module contains info on all the available
   8 !   GRIB2 Grid Definition Templates used in Section 3 (GDS).
   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 3.120 as an example )
  16 !
  17 !   This module also contains two subroutines.  Subroutine getgridtemplate
  18 !   returns the octet map for a specified Template number, and
  19 !   subroutine extgridtemplate 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-09  Gilbert
  38 ! 2003-09-02  Gilbert   -  Added GDT 3.31 - Albers Equal Area
  39 !
  40 ! USAGE:    use gridtemplates
  41 !
  42 ! ATTRIBUTES:
  43 !   LANGUAGE: Fortran 90
  44 !   MACHINE:  IBM SP
  45 !
  46 !$$$
  47
  48       integer,parameter :: MAXLEN=200,MAXTEMP=23
  49
  50       type gridtemplate
  51           integer :: template_num
  52           integer :: mapgridlen
  53           integer,dimension(MAXLEN) :: mapgrid
  54           logical :: needext
  55       end type gridtemplate
  56
  57       type(gridtemplate),dimension(MAXTEMP) :: templates
  58
  59       data templates(1)%template_num /0/     !  Lat/Lon
  60       data templates(1)%mapgridlen /19/
  61       data templates(1)%needext /.false./
  62       data (templates(1)%mapgrid(j),j=1,19)
  63      &              /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1/
  64
  65       data templates(2)%template_num /1/     !  Rotated Lat/Lon
  66       data templates(2)%mapgridlen /22/
  67       data templates(2)%needext /.false./
  68       data (templates(2)%mapgrid(j),j=1,22)
  69      &              /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,4/
  70
  71       data templates(3)%template_num /2/     !  Stretched Lat/Lon
  72       data templates(3)%mapgridlen /22/
  73       data templates(3)%needext /.false./
  74       data (templates(3)%mapgrid(j),j=1,22)
  75      &              /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,-4/
  76
  77       data templates(4)%template_num /3/     !  Stretched & Rotated Lat/Lon
  78       data templates(4)%mapgridlen /25/
  79       data templates(4)%needext /.false./
  80       data (templates(4)%mapgrid(j),j=1,25)
  81      &       /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,4,-4,4,-4/
  82
  83       data templates(5)%template_num /10/     !  Mercator
  84       data templates(5)%mapgridlen /19/
  85       data templates(5)%needext /.false./
  86       data (templates(5)%mapgrid(j),j=1,19)
  87      &              /1,1,4,1,4,1,4,4,4,-4,4,1,-4,-4,4,1,4,4,4/
  88
  89       data templates(6)%template_num /20/     !  Polar Stereographic
  90       data templates(6)%mapgridlen /18/
  91       data templates(6)%needext /.false./
  92       data (templates(6)%mapgrid(j),j=1,18)
  93      &              /1,1,4,1,4,1,4,4,4,-4,4,1,-4,4,4,4,1,1/
  94
  95       data templates(7)%template_num /30/     !  Lambert Conformal
  96       data templates(7)%mapgridlen /22/
  97       data templates(7)%needext /.false./
  98       data (templates(7)%mapgrid(j),j=1,22)
  99      &              /1,1,4,1,4,1,4,4,4,-4,4,1,-4,4,4,4,1,1,-4,-4,-4,4/
 100
 101       data templates(8)%template_num /40/     !  Gaussian Lat/Lon
 102       data templates(8)%mapgridlen /19/
 103       data templates(8)%needext /.false./
 104       data (templates(8)%mapgrid(j),j=1,19)
 105      &              /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1/
 106
 107       data templates(9)%template_num /41/     !  Rotated Gaussian Lat/Lon
 108       data templates(9)%mapgridlen /22/
 109       data templates(9)%needext /.false./
 110       data (templates(9)%mapgrid(j),j=1,22)
 111      &              /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,4/
 112
 113       data templates(10)%template_num /42/     !  Stretched Gaussian Lat/Lon
 114       data templates(10)%mapgridlen /22/
 115       data templates(10)%needext /.false./
 116       data (templates(10)%mapgrid(j),j=1,22)
 117      &              /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,-4/
 118
 119       data templates(11)%template_num /43/     !  Strtchd and Rot'd Gaus Lat/Lon
 120       data templates(11)%mapgridlen /25/
 121       data templates(11)%needext /.false./
 122       data (templates(11)%mapgrid(j),j=1,25)
 123      &          /1,1,4,1,4,1,4,4,4,4,4,-4,4,1,-4,4,4,4,1,-4,4,4,-4,4,-4/
 124
 125       data templates(12)%template_num /50/    !  Spherical Harmonic Coefficients
 126       data templates(12)%mapgridlen /5/
 127       data templates(12)%needext /.false./
 128       data (templates(12)%mapgrid(j),j=1,5) /4,4,4,1,1/
 129
 130       data templates(13)%template_num /51/   !  Rotated Spherical Harmonic Coeff
 131       data templates(13)%mapgridlen /8/
 132       data templates(13)%needext /.false./
 133       data (templates(13)%mapgrid(j),j=1,8) /4,4,4,1,1,-4,4,4/
 134
 135       data templates(14)%template_num /52/   !  Stretch Spherical Harmonic Coeff
 136       data templates(14)%mapgridlen /8/
 137       data templates(14)%needext /.false./
 138       data (templates(14)%mapgrid(j),j=1,8) /4,4,4,1,1,-4,4,-4/
 139
 140       data templates(15)%template_num /53/   !  Strch and Rot Spher Harm Coeffs
 141       data templates(15)%mapgridlen /11/
 142       data templates(15)%needext /.false./
 143       data (templates(15)%mapgrid(j),j=1,11) /4,4,4,1,1,-4,4,4,-4,4,-4/
 144
 145       data templates(16)%template_num /90/     !  Space view Perspective
 146       data templates(16)%mapgridlen /21/
 147       data templates(16)%needext /.false./
 148       data (templates(16)%mapgrid(j),j=1,21)
 149      &              /1,1,4,1,4,1,4,4,4,-4,4,1,4,4,4,4,1,4,4,4,4/
 150
 151       data templates(17)%template_num /100/    !  Triangular grid (icosahedron)
 152       data templates(17)%mapgridlen /11/
 153       data templates(17)%needext /.false./
 154       data (templates(17)%mapgrid(j),j=1,11) /1,1,2,1,-4,4,4,1,1,1,4/
 155
 156       data templates(18)%template_num /110/ !  Equatorial Azimuthal equidistant
 157       data templates(18)%mapgridlen /16/
 158       data templates(18)%needext /.false./
 159       data (templates(18)%mapgrid(j),j=1,16)
 160      &              /1,1,4,1,4,1,4,4,4,-4,4,1,4,4,1,1/
 161
 162        data templates(19)%template_num /120/     !  Azimuth-range
 163        data templates(19)%mapgridlen /7/
 164        data templates(19)%needext /.true./
 165        data (templates(19)%mapgrid(j),j=1,7) /4,4,-4,4,4,4,1/
 166
 167        data templates(20)%template_num /1000/     !  Cross Section Grid
 168        data templates(20)%mapgridlen /20/
 169        data templates(20)%needext /.true./
 170        data (templates(20)%mapgrid(j),j=1,20)
 171      &              /1,1,4,1,4,1,4,4,4,4,-4,4,1,4,4,1,2,1,1,2/
 172
 173        data templates(21)%template_num /1100/     !  Hovmoller Diagram Grid
 174        data templates(21)%mapgridlen /28/
 175        data templates(21)%needext /.false./
 176        data (templates(21)%mapgrid(j),j=1,28)
 177      &    /1,1,4,1,4,1,4,4,4,4,-4,4,1,-4,4,1,4,1,-4,1,1,-4,2,1,1,1,1,1/
 178
 179        data templates(22)%template_num /1200/     !  Time Section Grid
 180        data templates(22)%mapgridlen /16/
 181        data templates(22)%needext /.true./
 182        data (templates(22)%mapgrid(j),j=1,16)
 183      &              /4,1,-4,1,1,-4,2,1,1,1,1,1,2,1,1,2/
 184
 185       data templates(23)%template_num /31/     !  Albers Equal Area
 186       data templates(23)%mapgridlen /22/
 187       data templates(23)%needext /.false./
 188       data (templates(23)%mapgrid(j),j=1,22)
 189      &              /1,1,4,1,4,1,4,4,4,-4,4,1,-4,4,4,4,1,1,-4,-4,-4,4/
 190
 191       contains
 192
 193
 194          integer function getgridindex(number)
 195 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 196 !                .      .    .                                       .
 197 ! SUBPROGRAM:    getgridindex
 198 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-06-28
 199 !
 200 ! ABSTRACT: This function returns the index of specified Grid
 201 !   Definition Template 3.NN (NN=number) in array templates.
 202 !
 203 ! PROGRAM HISTORY LOG:
 204 ! 2001-06-28  Gilbert
 205 !
 206 ! USAGE:    index=getgridindex(number)
 207 !   INPUT ARGUMENT LIST:
 208 !     number   - NN, indicating the number of the Grid Definition
 209 !                Template 3.NN that is being requested.
 210 !
 211 ! RETURNS:  Index of GDT 3.NN in array templates, if template exists.
 212 !           = -1, otherwise.
 213 !
 214 ! REMARKS: None
 215 !
 216 ! ATTRIBUTES:
 217 !   LANGUAGE: Fortran 90
 218 !   MACHINE:  IBM SP
 219 !
 220 !$$$
 221            integer,intent(in) :: number
 222
 223            getgridindex=-1
 224
 225            do j=1,MAXTEMP
 226               if (number.eq.templates(j)%template_num) then
 227                  getgridindex=j
 228                  return
 229               endif
 230            enddo
 231
 232          end function
 233
 234
 235          subroutine getgridtemplate(number,nummap,map,needext,iret)
 236 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 237 !                .      .    .                                       .
 238 ! SUBPROGRAM:    getgridtemplate
 239 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-09
 240 !
 241 ! ABSTRACT: This subroutine returns grid template information for a
 242 !   specified Grid Definition Template 3.NN.
 243 !   The number of entries in the template is returned along with a map
 244 !   of the number of octets occupied by each entry.  Also, a flag is
 245 !   returned to indicate whether the template would need to be extended.
 246 !
 247 ! PROGRAM HISTORY LOG:
 248 ! 2000-05-09  Gilbert
 249 !
 250 ! USAGE:    CALL getgridtemplate(number,nummap,map,needext,iret)
 251 !   INPUT ARGUMENT LIST:
 252 !     number   - NN, indicating the number of the Grid Definition
 253 !                Template 3.NN that is being requested.
 254 !
 255 !   OUTPUT ARGUMENT LIST:
 256 !     nummap   - Number of entries in the Template
 257 !     map()    - An array containing the number of octets that each
 258 !                template entry occupies when packed up into the GDS.
 259 !     needext  - Logical variable indicating whether the Grid Defintion
 260 !                Template has to be extended.
 261 !     ierr     - Error return code.
 262 !                0 = no error
 263 !                1 = Undefine Grid Template number.
 264 !
 265 ! REMARKS: None
 266 !
 267 ! ATTRIBUTES:
 268 !   LANGUAGE: Fortran 90
 269 !   MACHINE:  IBM SP
 270 !
 271 !$$$
 272            integer,intent(in) :: number
 273            integer,intent(out) :: nummap,map(*),iret
 274            logical,intent(out) :: needext
 275
 276            iret=0
 277
 278            index=getgridindex(number)
 279
 280            if (index.ne.-1) then
 281               nummap=templates(index)%mapgridlen
 282               needext=templates(index)%needext
 283               map(1:nummap)=templates(index)%mapgrid(1:nummap)
 284            else
 285              nummap=0
 286              needext=.false.
 287              print *,'getgridtemplate: Grid Template ',number,
 288      &               ' not defined.'
 289              iret=1
 290            endif
 291
 292          end subroutine
 293
 294
 295          subroutine extgridtemplate(number,list,nummap,map)
 296 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 297 !                .      .    .                                       .
 298 ! SUBPROGRAM:    extgridtemplate
 299 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-09
 300 !
 301 ! ABSTRACT: This subroutine generates the remaining octet map for a
 302 !   given Grid Definition Template, if required.  Some Templates can
 303 !   vary depending on data values given in an earlier part of the
 304 !   Template, and it is necessary to know some of the earlier entry
 305 !   values to generate the full octet map of the Template.
 306 !
 307 ! PROGRAM HISTORY LOG:
 308 ! 2000-05-09  Gilbert
 309 !
 310 ! USAGE:    CALL extgridtemplate(number,list,nummap,map)
 311 !   INPUT ARGUMENT LIST:
 312 !     number   - NN, indicating the number of the Grid Definition
 313 !                Template 3.NN that is being requested.
 314 !     list()   - The list of values for each entry in
 315 !                the Grid Definition Template.
 316 !
 317 !   OUTPUT ARGUMENT LIST:
 318 !     nummap   - Number of entries in the Template
 319 !     map()    - An array containing the number of octets that each
 320 !                template entry occupies when packed up into the GDS.
 321 !
 322 ! ATTRIBUTES:
 323 !   LANGUAGE: Fortran 90
 324 !   MACHINE:  IBM SP
 325 !
 326 !$$$
 327            integer,intent(in) :: number,list(*)
 328            integer,intent(out) :: nummap,map(*)
 329
 330            index=getgridindex(number)
 331            if (index.eq.-1) return
 332
 333            if ( .not. templates(index)%needext ) return
 334            nummap=templates(index)%mapgridlen
 335            map(1:nummap)=templates(index)%mapgrid(1:nummap)
 336
 337            if ( number.eq.120 ) then
 338               N=list(2)
 339               do i=1,N
 340                 map(nummap+1)=2
 341                 map(nummap+2)=-2
 342                 nummap=nummap+2
 343               enddo
 344            elseif ( number.eq.1000 ) then
 345               N=list(20)
 346               do i=1,N
 347                 map(nummap+1)=4
 348                 nummap=nummap+1
 349               enddo
 350            elseif ( number.eq.1200 ) then
 351               N=list(16)
 352               do i=1,N
 353                 map(nummap+1)=4
 354                 nummap=nummap+1
 355               enddo
 356            endif
 357
 358          end subroutine
 359
 360          integer function getgdtlen(number)
 361 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 362 !                .      .    .                                       .
 363 ! SUBPROGRAM:    getgdtlen
 364 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-05-11
 365 !
 366 ! ABSTRACT: This function returns the initial length (number of entries) in
 367 !   the "static" part of specified Grid Definition Template 3.number.
 368 !
 369 ! PROGRAM HISTORY LOG:
 370 ! 2004-05-11  Gilbert
 371 !
 372 ! USAGE:    CALL getgdtlen(number)
 373 !   INPUT ARGUMENT LIST:
 374 !     number   - NN, indicating the number of the Grid Definition
 375 !                Template 3.NN that is being requested.
 376 !
 377 ! RETURNS:     Number of entries in the "static" part of GDT 3.number
 378 !              OR returns 0, if requested template is not found.
 379 !
 380 ! REMARKS: If user needs the full length of a specific template that
 381 !    contains additional entries based on values set in the "static" part
 382 !    of the GDT, subroutine extgridtemplate can be used.
 383 !
 384 ! ATTRIBUTES:
 385 !   LANGUAGE: Fortran 90
 386 !   MACHINE:  IBM SP
 387 !
 388 !$$$
 389            integer,intent(in) :: number
 390
 391            getgdtlen=0
 392
 393            index=getgridindex(number)
 394
 395            if (index.ne.-1) then
 396               getgdtlen=templates(index)%mapgridlen
 397            endif
 398
 399          end function
 400
 401
 402       end
 403