hwrf-baseline-20120103-1354/ungrib/src/ngl/g2/pdstemplates.f

   1       module pdstemplates
   2 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   3 !                .      .    .                                       .
   4 ! MODULE:    pdstemplates
   5 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-11
   6 !
   7 ! ABSTRACT: This Fortran Module contains info on all the available
   8 !   GRIB2 Product Definition Templates used in Section 4 (PDS).
   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 4.3 as an example )
  16 !
  17 !   This module also contains two subroutines.  Subroutine getpdstemplate
  18 !   returns the octet map for a specified Template number, and
  19 !   subroutine extpdstemplate 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 ! 2001-12-04  Gilbert  -  Added Templates 4.12, 4.12, 4.14,
  39 !                         4.1000, 4.1001, 4.1002, 4.1100 and 4.1101
  40 ! 2009-05-21  VUONG    -  Allow negative scale factors and limits for
  41 !                         Templates 4.5 and 4.9
  42 ! 2009-12-14  VUONG    -  Added Templates (Satellite Product) 4.31
  43 !                         Added Templates (ICAO WAFS) 4.15
  44 ! 2010-08-03  VUONG    -  Added Templates 4.40,4.41,4.42,.4.43
  45 ! 2010-12-08  Vuong    -  Corrected Product Definition Template 4.42 and 4.43
  46 !
  47 ! USAGE:    use pdstemplates
  48 !
  49 ! ATTRIBUTES:
  50 !   LANGUAGE: Fortran 90
  51 !   MACHINE:  IBM SP
  52 !
  53 !$$$
  54
  55       integer,parameter :: MAXLEN=200,MAXTEMP=29
  56
  57       type pdstemplate
  58           integer :: template_num
  59           integer :: mappdslen
  60           integer,dimension(MAXLEN) :: mappds
  61           logical :: needext
  62       end type pdstemplate
  63
  64       type(pdstemplate),dimension(MAXTEMP) :: templates
  65
  66       data templates(1)%template_num /0/     !  Fcst at Level/Layer
  67       data templates(1)%mappdslen /15/
  68       data templates(1)%needext /.false./
  69       data (templates(1)%mappds(j),j=1,15)
  70      &                             /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/
  71
  72       data templates(2)%template_num /1/     !  Ens fcst at level/layer
  73       data templates(2)%mappdslen /18/
  74       data templates(2)%needext /.false./
  75       data (templates(2)%mappds(j),j=1,18)
  76      &                        /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1/
  77
  78       data templates(3)%template_num /2/     !  Derived Ens fcst at level/layer
  79       data templates(3)%mappdslen /17/
  80       data templates(3)%needext /.false./
  81       data (templates(3)%mappds(j),j=1,17)
  82      &                      /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1/
  83
  84       data templates(4)%template_num /3/     !  Ens cluster fcst rect. area
  85       data templates(4)%mappdslen /31/
  86       data templates(4)%needext /.true./
  87       data (templates(4)%mappds(j),j=1,31)
  88      &       /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,-4,4,4,
  89      &        1,-1,4,-1,4/
  90
  91       data templates(5)%template_num /4/     !  Ens cluster fcst circ. area
  92       data templates(5)%mappdslen /30/
  93       data templates(5)%needext /.true./
  94       data (templates(5)%mappds(j),j=1,30)
  95      &       /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,4,4,
  96      &        1,-1,4,-1,4/
  97
  98       data templates(6)%template_num /5/     !  Prob fcst at level/layer
  99       data templates(6)%mappdslen /22/
 100       data templates(6)%needext /.false./
 101       data (templates(6)%mappds(j),j=1,22)
 102      &          /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,-1,-4,-1,-4/
 103
 104       data templates(7)%template_num /6/     !  Percentile fcst at level/layer
 105       data templates(7)%mappdslen /16/
 106       data templates(7)%needext /.false./
 107       data (templates(7)%mappds(j),j=1,16)
 108      &                     /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1/
 109
 110       data templates(8)%template_num /7/     !  Error at level/layer
 111       data templates(8)%mappdslen /15/
 112       data templates(8)%needext /.false./
 113       data (templates(8)%mappds(j),j=1,15)
 114      &                     /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/
 115
 116       data templates(9)%template_num /8/     !  Ave or Accum at level/layer
 117       data templates(9)%mappdslen /29/
 118       data templates(9)%needext /.true./
 119       data (templates(9)%mappds(j),j=1,29)
 120      &  /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/
 121
 122       data templates(10)%template_num /9/     !  Prob over time interval
 123       data templates(10)%mappdslen /36/
 124       data templates(10)%needext /.true./
 125       data (templates(10)%mappds(j),j=1,36)
 126      &  /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,-1,-4,-1,-4,2,1,1,1,
 127      &   1,1,1,4,1,1,1,4,1,4/
 128
 129       data templates(11)%template_num /10/     !  Percentile over time interval
 130       data templates(11)%mappdslen /30/
 131       data templates(11)%needext /.true./
 132       data (templates(11)%mappds(j),j=1,30)
 133      &    /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,2,1,1,1,1,1,1,4,
 134      &     1,1,1,4,1,4/
 135
 136       data templates(12)%template_num /11/     !  Ens member over time interval
 137       data templates(12)%mappdslen /32/
 138       data templates(12)%needext /.true./
 139       data (templates(12)%mappds(j),j=1,32)
 140      &    /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,2,1,1,1,1,1,1,
 141      &     4,1,1,1,4,1,4/
 142
 143       data templates(13)%template_num /12/     !  Derived Ens fcst over time int
 144       data templates(13)%mappdslen /31/
 145       data templates(13)%needext /.true./
 146       data (templates(13)%mappds(j),j=1,31)
 147      &                   /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,
 148      &                    2,1,1,1,1,1,1,4,1,1,1,4,1,4/
 149
 150       data templates(14)%template_num /13/     !  Ens cluster fcst rect. area
 151       data templates(14)%mappdslen /45/
 152       data templates(14)%needext /.true./
 153       data (templates(14)%mappds(j),j=1,45)
 154      &       /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,-4,4,4,
 155      &        1,-1,4,-1,4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/
 156
 157       data templates(15)%template_num /14/     !  Ens cluster fcst circ. area
 158       data templates(15)%mappdslen /44/
 159       data templates(15)%needext /.true./
 160       data (templates(15)%mappds(j),j=1,44)
 161      &       /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,1,1,1,1,-4,4,4,
 162      &        1,-1,4,-1,4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/
 163
 164       data templates(16)%template_num /20/     !  Radar Product
 165       data templates(16)%mappdslen /19/
 166       data templates(16)%needext /.false./
 167       data (templates(16)%mappds(j),j=1,19)
 168      &                     /1,1,1,1,1,-4,4,2,4,2,1,1,1,1,1,2,1,3,2/
 169
 170       data templates(17)%template_num /30/     !  Satellite Product
 171       data templates(17)%mappdslen /5/
 172       data templates(17)%needext /.true./
 173       data (templates(17)%mappds(j),j=1,5)
 174      &                            /1,1,1,1,1/
 175
 176       data templates(18)%template_num /254/     !  CCITTIA5 Character String
 177       data templates(18)%mappdslen /3/
 178       data templates(18)%needext /.false./
 179       data (templates(18)%mappds(j),j=1,3)
 180      &                     /1,1,4/
 181
 182       data templates(19)%template_num /1000/     !  Cross section
 183       data templates(19)%mappdslen /9/
 184       data templates(19)%needext /.false./
 185       data (templates(19)%mappds(j),j=1,9)
 186      &                     /1,1,1,1,1,2,1,1,4/
 187
 188       data templates(20)%template_num /1001/     !  Cross section over time
 189       data templates(20)%mappdslen /16/
 190       data templates(20)%needext /.false./
 191       data (templates(20)%mappds(j),j=1,16)
 192      &                     /1,1,1,1,1,2,1,1,4,4,1,1,1,4,1,4/
 193
 194       data templates(21)%template_num /1002/     !  Cross section processed time
 195       data templates(21)%mappdslen /15/
 196       data templates(21)%needext /.false./
 197       data (templates(21)%mappds(j),j=1,15)
 198      &                     /1,1,1,1,1,2,1,1,4,1,1,1,4,4,2/
 199
 200       data templates(22)%template_num /1100/     !  Hovmoller grid
 201       data templates(22)%mappdslen /15/
 202       data templates(22)%needext /.false./
 203       data (templates(22)%mappds(j),j=1,15)
 204      &                     /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/
 205
 206       data templates(23)%template_num /1101/     !  Hovmoller with stat proc
 207       data templates(23)%mappdslen /22/
 208       data templates(23)%needext /.false./
 209       data (templates(23)%mappds(j),j=1,22)
 210      &               /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,4,1,1,1,4,1,4/
 211
 212       data templates(24)%template_num /31/     !  Satellite Product
 213       data templates(24)%mappdslen /5/
 214       data templates(24)%needext /.true./
 215       data (templates(24)%mappds(j),j=1,5)
 216      &                            /1,1,1,1,1/
 217
 218       data templates(25)%template_num /15/     !  Ave or Accum at level/layer
 219       data templates(25)%mappdslen /18/        !  For ICAO WAFS products
 220       data templates(25)%needext /.false./
 221       data (templates(25)%mappds(j),j=1,18)
 222      &  /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1/
 223
 224       data templates(26)%template_num /40/     !  Analysis or Forecast at a horizontal or in a
 225       data templates(26)%mappdslen /16/        !  horizontal layer at a point in time for
 226       data templates(26)%needext /.false./     !  atmospheric chemical constituents
 227       data (templates(26)%mappds(j),j=1,16)
 228      &  /1,1,2,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/
 229
 230       data templates(27)%template_num /41/     !  Individual ensemble forecast, control and
 231       data templates(27)%mappdslen /19/        !  perturbed, at horizontal level or
 232       data templates(27)%needext /.false./     !  in a horizontal layer at a point in time for
 233       data (templates(27)%mappds(j),j=1,19)    !  atmospheric chemical constituents
 234      &  /1,1,2,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1/
 235
 236       data templates(28)%template_num /42/     !  Average, Accumulation, and/or extreme values or other
 237       data templates(28)%mappdslen /30/        !  statistically-processed values at horizontal level or
 238       data templates(28)%needext /.true./      !  in a horizontal layer in contnunuous or non-continuous time
 239       data (templates(28)%mappds(j),j=1,30)    !  interval for atmospheric chemical constituents
 240      &  /1,1,2,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,2,1,1,1,1,1,1,4,
 241      &   1,1,1,4,1,4/
 242
 243       data templates(29)%template_num /43/     !  Individual ensemble forecast, control and
 244       data templates(29)%mappdslen /33/        !  perturbed, at horizontal level or in a horizontal
 245       data templates(29)%needext /.true./      !  layer at a point in a continuous or non-continuous time
 246       data (templates(29)%mappds(j),j=1,33)    !  interval for atmospheric chemical constituents
 247      &  /1,1,2,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,2,1,1,1,1,1,1,4,
 248      &   1,1,1,4,1,4/
 249
 250       contains
 251
 252          integer function getpdsindex(number)
 253 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 254 !                .      .    .                                       .
 255 ! SUBPROGRAM:    getpdsindex
 256 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2001-06-28
 257 !
 258 ! ABSTRACT: This function returns the index of specified Product
 259 !   Definition Template 4.NN (NN=number) in array templates.
 260 !
 261 ! PROGRAM HISTORY LOG:
 262 ! 2001-06-28  Gilbert
 263 !
 264 ! USAGE:    index=getpdsindex(number)
 265 !   INPUT ARGUMENT LIST:
 266 !     number   - NN, indicating the number of the Product Definition
 267 !                Template 4.NN that is being requested.
 268 !
 269 ! RETURNS:  Index of PDT 4.NN in array templates, if template exists.
 270 !           = -1, otherwise.
 271 !
 272 ! REMARKS: None
 273 !
 274 ! ATTRIBUTES:
 275 !   LANGUAGE: Fortran 90
 276 !   MACHINE:  IBM SP
 277 !
 278 !$$$
 279            integer,intent(in) :: number
 280
 281            getpdsindex=-1
 282
 283            do j=1,MAXTEMP
 284               if (number.eq.templates(j)%template_num) then
 285                  getpdsindex=j
 286                  return
 287               endif
 288            enddo
 289
 290          end function
 291
 292
 293          subroutine getpdstemplate(number,nummap,map,needext,iret)
 294 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 295 !                .      .    .                                       .
 296 ! SUBPROGRAM:    getpdstemplate
 297 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-11
 298 !
 299 ! ABSTRACT: This subroutine returns PDS template information for a
 300 !   specified Product Definition Template 4.NN.
 301 !   The number of entries in the template is returned along with a map
 302 !   of the number of octets occupied by each entry.  Also, a flag is
 303 !   returned to indicate whether the template would need to be extended.
 304 !
 305 ! PROGRAM HISTORY LOG:
 306 ! 2000-05-11  Gilbert
 307 ! 2010-08-03  VUONG    -  Added Templates 4.40,4.41,4.42,.4.43
 308 ! 2010-12-08  Vuong    -  Corrected Product Definition Template 4.42 and 4.43
 309 !
 310 ! USAGE:    CALL getpdstemplate(number,nummap,map,needext,iret)
 311 !   INPUT ARGUMENT LIST:
 312 !     number   - NN, indicating the number of the Product Definition
 313 !                Template 4.NN that is being requested.
 314 !
 315 !   OUTPUT ARGUMENT LIST:
 316 !     nummap   - Number of entries in the Template
 317 !     map()    - An array containing the number of octets that each
 318 !                template entry occupies when packed up into the PDS.
 319 !     needext  - Logical variable indicating whether the Product Defintion
 320 !                Template has to be extended.
 321 !     ierr     - Error return code.
 322 !                0 = no error
 323 !                1 = Undefine Product Template number.
 324 !
 325 ! REMARKS: None
 326 !
 327 ! ATTRIBUTES:
 328 !   LANGUAGE: Fortran 90
 329 !   MACHINE:  IBM SP
 330 !
 331 !$$$
 332            integer,intent(in) :: number
 333            integer,intent(out) :: nummap,map(*),iret
 334            logical,intent(out) :: needext
 335
 336            iret=0
 337
 338            index=getpdsindex(number)
 339
 340            if (index.ne.-1) then
 341               nummap=templates(index)%mappdslen
 342               needext=templates(index)%needext
 343               map(1:nummap)=templates(index)%mappds(1:nummap)
 344            else
 345              nummap=0
 346              needext=.false.
 347              print *,'getpdstemplate: PDS Template ',number,
 348      &               ' not defined.'
 349              iret=1
 350            endif
 351
 352          end subroutine
 353
 354          subroutine extpdstemplate(number,list,nummap,map)
 355 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 356 !                .      .    .                                       .
 357 ! SUBPROGRAM:    extpdstemplate
 358 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2000-05-11
 359 !
 360 ! ABSTRACT: This subroutine generates the remaining octet map for a
 361 !   given Product Definition Template, if required.  Some Templates can
 362 !   vary depending on data values given in an earlier part of the
 363 !   Template, and it is necessary to know some of the earlier entry
 364 !   values to generate the full octet map of the Template.
 365 !
 366 ! PROGRAM HISTORY LOG:
 367 ! 2000-05-11  Gilbert
 368 ! 2010-08-03  VUONG    -  Added Templates 4.40,4.41,4.42,.4.43
 369 ! 2010-12-08  Vuong    -  Corrected Product Definition Template 4.42 and 4.43
 370 !
 371 ! USAGE:    CALL extpdstemplate(number,list,nummap,map)
 372 !   INPUT ARGUMENT LIST:
 373 !     number   - NN, indicating the number of the Product Definition
 374 !                Template 4.NN that is being requested.
 375 !     list()   - The list of values for each entry in the
 376 !                the Product Definition Template 4.NN.
 377 !
 378 !   OUTPUT ARGUMENT LIST:
 379 !     nummap   - Number of entries in the Template
 380 !     map()    - An array containing the number of octets that each
 381 !                template entry occupies when packed up into the GDS.
 382 !
 383 ! ATTRIBUTES:
 384 !   LANGUAGE: Fortran 90
 385 !   MACHINE:  IBM SP
 386 !
 387 !$$$
 388            integer,intent(in) :: number,list(*)
 389            integer,intent(out) :: nummap,map(*)
 390
 391            index=getpdsindex(number)
 392            if (index.eq.-1) return
 393
 394            if ( .not. templates(index)%needext ) return
 395            nummap=templates(index)%mappdslen
 396            map(1:nummap)=templates(index)%mappds(1:nummap)
 397
 398            if ( number.eq.3 ) then
 399               N=list(27)
 400               do i=1,N
 401                 map(nummap+i)=1
 402               enddo
 403               nummap=nummap+N
 404            elseif ( number.eq.4 ) then
 405               N=list(26)
 406               do i=1,N
 407                 map(nummap+i)=1
 408               enddo
 409               nummap=nummap+N
 410            elseif ( number.eq.8 ) then
 411               if ( list(22).gt.1 ) then
 412                 do j=2,list(22)
 413                   do k=1,6
 414                     map(nummap+k)=map(23+k)
 415                   enddo
 416                   nummap=nummap+6
 417                 enddo
 418               endif
 419            elseif ( number.eq.9 ) then
 420               if ( list(29).gt.1 ) then
 421                 do j=2,list(29)
 422                   do k=1,6
 423                     map(nummap+k)=map(30+k)
 424                   enddo
 425                   nummap=nummap+6
 426                 enddo
 427               endif
 428            elseif ( number.eq.10 ) then
 429               if ( list(23).gt.1 ) then
 430                 do j=2,list(23)
 431                   do k=1,6
 432                     map(nummap+k)=map(24+k)
 433                   enddo
 434                   nummap=nummap+6
 435                 enddo
 436               endif
 437            elseif ( number.eq.11 ) then
 438               if ( list(25).gt.1 ) then
 439                 do j=2,list(25)
 440                   do k=1,6
 441                     map(nummap+k)=map(26+k)
 442                   enddo
 443                   nummap=nummap+6
 444                 enddo
 445               endif
 446            elseif ( number.eq.12 ) then
 447               if ( list(24).gt.1 ) then
 448                 do j=2,list(24)
 449                   do k=1,6
 450                     map(nummap+k)=map(25+k)
 451                   enddo
 452                   nummap=nummap+6
 453                 enddo
 454               endif
 455            elseif ( number.eq.13 ) then
 456               if ( list(38).gt.1 ) then
 457                 do j=2,list(38)
 458                   do k=1,6
 459                     map(nummap+k)=map(39+k)
 460                   enddo
 461                   nummap=nummap+6
 462                 enddo
 463               endif
 464               N=list(27)
 465               do i=1,N
 466                 map(nummap+i)=1
 467               enddo
 468               nummap=nummap+N
 469            elseif ( number.eq.14 ) then
 470               if ( list(37).gt.1 ) then
 471                 do j=2,list(37)
 472                   do k=1,6
 473                     map(nummap+k)=map(38+k)
 474                   enddo
 475                   nummap=nummap+6
 476                 enddo
 477               endif
 478               N=list(26)
 479               do i=1,N
 480                 map(nummap+i)=1
 481               enddo
 482               nummap=nummap+N
 483            elseif ( number.eq.30 ) then
 484               do j=1,list(5)
 485                 map(nummap+1)=2
 486                 map(nummap+2)=2
 487                 map(nummap+3)=1
 488                 map(nummap+4)=1
 489                 map(nummap+5)=4
 490                 nummap=nummap+5
 491               enddo
 492            elseif ( number.eq.31 ) then
 493               do j=1,list(5)
 494                 map(nummap+1)=2
 495                 map(nummap+2)=2
 496                 map(nummap+3)=2
 497                 map(nummap+4)=1
 498                 map(nummap+5)=4
 499                 nummap=nummap+5
 500               enddo
 501            elseif ( number.eq.42 ) then
 502               if ( list(23).gt.1 ) then
 503                 do j=2,list(23)
 504                   do k=1,6
 505                     map(nummap+k)=map(24+k)
 506                   enddo
 507                   nummap=nummap+6
 508                 enddo
 509               endif
 510            elseif ( number.eq.43 ) then
 511               if ( list(26).gt.1 ) then
 512                 do j=2,list(26)
 513                   do k=1,6
 514                     map(nummap+k)=map(27+k)
 515                   enddo
 516                   nummap=nummap+6
 517                 enddo
 518               endif
 519            endif
 520
 521          end subroutine
 522
 523          integer function getpdtlen(number)
 524 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
 525 !                .      .    .                                       .
 526 ! SUBPROGRAM:    getpdtlen
 527 !   PRGMMR: Gilbert         ORG: W/NP11    DATE: 2004-05-11
 528 !
 529 ! ABSTRACT: This function returns the initial length (number of entries) in
 530 !   the "static" part of specified Product Definition Template 4.number.
 531 !
 532 ! PROGRAM HISTORY LOG:
 533 ! 2004-05-11  Gilbert
 534 !
 535 ! USAGE:    CALL getpdtlen(number)
 536 !   INPUT ARGUMENT LIST:
 537 !     number   - NN, indicating the number of the Product Definition
 538 !                Template 4.NN that is being requested.
 539 !
 540 ! RETURNS:     Number of entries in the "static" part of PDT 4.number
 541 !              OR returns 0, if requested template is not found.
 542 !
 543 ! REMARKS: If user needs the full length of a specific template that
 544 !    contains additional entries based on values set in the "static" part
 545 !    of the PDT, subroutine extpdstemplate can be used.
 546 !
 547 ! ATTRIBUTES:
 548 !   LANGUAGE: Fortran 90
 549 !   MACHINE:  IBM SP
 550 !
 551 !$$$
 552            integer,intent(in) :: number
 553
 554            getpdtlen=0
 555
 556            index=getpdsindex(number)
 557
 558            if (index.ne.-1) then
 559               getpdtlen=templates(index)%mappdslen
 560            endif
 561
 562          end function
 563
 564
 565       end module
 566