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