module pdstemplates
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! MODULE: pdstemplates
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11
!
! ABSTRACT: This Fortran Module contains info on all the available
! GRIB2 Product Definition Templates used in Section 4 (PDS).
! Each Template has three parts: The number of entries in the template
! (mapgridlen); A map of the template (mapgrid), which contains the
! number of octets in which to pack each of the template values; and
! a logical value (needext) that indicates whether the Template needs
! to be extended. In some cases the number of entries in a template
! can vary depending upon values specified in the "static" part of
! the template. ( See Template 4.3 as an example )
!
! This module also contains two subroutines. Subroutine getpdstemplate
! returns the octet map for a specified Template number, and
! subroutine extpdstemplate will calculate the extended octet map
! of an appropriate template given values for the "static" part of the
! template. See docblocks below for the arguments and usage of these
! routines.
!
! NOTE: Array mapgrid contains the number of octets in which the
! corresponding template values will be stored. A negative value in
! mapgrid is used to indicate that the corresponding template entry can
! contain negative values. This information is used later when packing
! (or unpacking) the template data values. Negative data values in GRIB
! are stored with the left most bit set to one, and a negative number
! of octets value in mapgrid() indicates that this possibility should
! be considered. The number of octets used to store the data value
! in this case would be the absolute value of the negative value in
! mapgrid().
!
!
! PROGRAM HISTORY LOG:
! 2000-05-11 Gilbert
! 2001-12-04 Gilbert - Added Templates 4.12, 4.12, 4.14,
! 4.1000, 4.1001, 4.1002, 4.1100 and 4.1101
! 2009-05-21 VUONG - Allow negative scale factors and limits for
! Templates 4.5 and 4.9
! 2009-12-14 VUONG - Added Templates (Satellite Product) 4.31
! Added Templates (ICAO WAFS) 4.15
! 2010-08-03 VUONG - Added Templates 4.40,4.41,4.42,.4.43
! 2010-12-08 Vuong - Corrected Product Definition Template 4.42 and 4.43
! 2012-02-07 Vuong - Added Templates 4.44,4.45,4.46,4.47,4.48,4.50,
! 4.51,4.91,4.32 and 4.52
! 2013-07-29 Vuong - Corrected 4.91 and added Templates 4.33,4.34,4.53,4.54
!
! USAGE: use pdstemplates
!
! ATTRIBUTES:
! LANGUAGE: Fortran 90
! MACHINE: IBM SP
!
!$$$
integer,parameter :: MAXLEN=200,MAXTEMP=43
type pdstemplate
integer :: template_num
integer :: mappdslen
integer,dimension(MAXLEN) :: mappds
logical :: needext
end type pdstemplate
type(pdstemplate),dimension(MAXTEMP) :: templates
data templates(1)%template_num /0/ ! Fcst at Level/Layer
data templates(1)%mappdslen /15/
data templates(1)%needext /.false./
data (templates(1)%mappds(j),j=1,15)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/
data templates(2)%template_num /1/ ! Ens fcst at level/layer
data templates(2)%mappdslen /18/
data templates(2)%needext /.false./
data (templates(2)%mappds(j),j=1,18)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1/
data templates(3)%template_num /2/ ! Derived Ens fcst at level/layer
data templates(3)%mappdslen /17/
data templates(3)%needext /.false./
data (templates(3)%mappds(j),j=1,17)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1/
data templates(4)%template_num /3/ ! Ens cluster fcst rect. area
data templates(4)%mappdslen /31/
data templates(4)%needext /.true./
data (templates(4)%mappds(j),j=1,31)
& /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,
& 1,-1,4,-1,4/
data templates(5)%template_num /4/ ! Ens cluster fcst circ. area
data templates(5)%mappdslen /30/
data templates(5)%needext /.true./
data (templates(5)%mappds(j),j=1,30)
& /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,
& 1,-1,4,-1,4/
data templates(6)%template_num /5/ ! Prob fcst at level/layer
data templates(6)%mappdslen /22/
data templates(6)%needext /.false./
data (templates(6)%mappds(j),j=1,22)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,-1,-4,-1,-4/
data templates(7)%template_num /6/ ! Percentile fcst at level/layer
data templates(7)%mappdslen /16/
data templates(7)%needext /.false./
data (templates(7)%mappds(j),j=1,16)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1/
data templates(8)%template_num /7/ ! Error at level/layer
data templates(8)%mappdslen /15/
data templates(8)%needext /.false./
data (templates(8)%mappds(j),j=1,15)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/
data templates(9)%template_num /8/ ! Ave or Accum at level/layer
data templates(9)%mappdslen /29/
data templates(9)%needext /.true./
data (templates(9)%mappds(j),j=1,29)
& /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/
data templates(10)%template_num /9/ ! Prob over time interval
data templates(10)%mappdslen /36/
data templates(10)%needext /.true./
data (templates(10)%mappds(j),j=1,36)
& /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,
& 1,1,1,4,1,1,1,4,1,4/
data templates(11)%template_num /10/ ! Percentile over time interval
data templates(11)%mappdslen /30/
data templates(11)%needext /.true./
data (templates(11)%mappds(j),j=1,30)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,2,1,1,1,1,1,1,4,
& 1,1,1,4,1,4/
data templates(12)%template_num /11/ ! Ens member over time interval
data templates(12)%mappdslen /32/
data templates(12)%needext /.true./
data (templates(12)%mappds(j),j=1,32)
& /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,
& 4,1,1,1,4,1,4/
data templates(13)%template_num /12/ ! Derived Ens fcst over time int
data templates(13)%mappdslen /31/
data templates(13)%needext /.true./
data (templates(13)%mappds(j),j=1,31)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,
& 2,1,1,1,1,1,1,4,1,1,1,4,1,4/
data templates(14)%template_num /13/ ! Ens cluster fcst rect. area
data templates(14)%mappdslen /45/
data templates(14)%needext /.true./
data (templates(14)%mappds(j),j=1,45)
& /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,
& 1,-1,4,-1,4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/
data templates(15)%template_num /14/ ! Ens cluster fcst circ. area
data templates(15)%mappdslen /44/
data templates(15)%needext /.true./
data (templates(15)%mappds(j),j=1,44)
& /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,
& 1,-1,4,-1,4,2,1,1,1,1,1,1,4,1,1,1,4,1,4/
data templates(16)%template_num /20/ ! Radar Product
data templates(16)%mappdslen /19/
data templates(16)%needext /.false./
data (templates(16)%mappds(j),j=1,19)
& /1,1,1,1,1,-4,4,2,4,2,1,1,1,1,1,2,1,3,2/
data templates(17)%template_num /30/ ! Satellite Product
data templates(17)%mappdslen /5/
data templates(17)%needext /.true./
data (templates(17)%mappds(j),j=1,5)
& /1,1,1,1,1/
data templates(18)%template_num /254/ ! CCITTIA5 Character String
data templates(18)%mappdslen /3/
data templates(18)%needext /.false./
data (templates(18)%mappds(j),j=1,3)
& /1,1,4/
data templates(19)%template_num /1000/ ! Cross section
data templates(19)%mappdslen /9/
data templates(19)%needext /.false./
data (templates(19)%mappds(j),j=1,9)
& /1,1,1,1,1,2,1,1,4/
data templates(20)%template_num /1001/ ! Cross section over time
data templates(20)%mappdslen /16/
data templates(20)%needext /.false./
data (templates(20)%mappds(j),j=1,16)
& /1,1,1,1,1,2,1,1,4,4,1,1,1,4,1,4/
data templates(21)%template_num /1002/ ! Cross section processed time
data templates(21)%mappdslen /15/
data templates(21)%needext /.false./
data (templates(21)%mappds(j),j=1,15)
& /1,1,1,1,1,2,1,1,4,1,1,1,4,4,2/
data templates(22)%template_num /1100/ ! Hovmoller grid
data templates(22)%mappdslen /15/
data templates(22)%needext /.false./
data (templates(22)%mappds(j),j=1,15)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/
data templates(23)%template_num /1101/ ! Hovmoller with stat proc
data templates(23)%mappdslen /22/
data templates(23)%needext /.false./
data (templates(23)%mappds(j),j=1,22)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,4,1,1,1,4,1,4/
data templates(24)%template_num /31/ ! Satellite Product
data templates(24)%mappdslen /5/
data templates(24)%needext /.true./
data (templates(24)%mappds(j),j=1,5)
& /1,1,1,1,1/
data templates(25)%template_num /15/ ! Ave or Accum at level/layer
data templates(25)%mappdslen /18/ ! For ICAO WAFS products
data templates(25)%needext /.false./
data (templates(25)%mappds(j),j=1,18)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1/
data templates(26)%template_num /40/ ! Analysis or Forecast at a horizontal or in a
data templates(26)%mappdslen /16/ ! horizontal layer at a point in time for
data templates(26)%needext /.false./ ! atmospheric chemical constituents
data (templates(26)%mappds(j),j=1,16)
& /1,1,2,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/
data templates(27)%template_num /41/ ! Individual ensemble forecast, control and
data templates(27)%mappdslen /19/ ! perturbed, at horizontal level or
data templates(27)%needext /.false./ ! in a horizontal layer at a point in time for
data (templates(27)%mappds(j),j=1,19) ! atmospheric chemical constituents
& /1,1,2,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1/
data templates(28)%template_num /42/ ! Average, Accumulation, and/or extreme values or other
data templates(28)%mappdslen /30/ ! statistically-processed values at horizontal level or
data templates(28)%needext /.true./ ! in a horizontal layer in contnunuous or non-continuous time
data (templates(28)%mappds(j),j=1,30) ! interval for atmospheric chemical constituents
& /1,1,2,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/
data templates(29)%template_num /43/ ! Individual ensemble forecast, control and
data templates(29)%mappdslen /33/ ! perturbed, at horizontal level or in a horizontal
data templates(29)%needext /.true./ ! layer at a point in a continuous or non-continuous time
data (templates(29)%mappds(j),j=1,33) ! interval for atmospheric chemical constituents
& /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,
& 1,1,1,4,1,4/
data templates(30)%template_num /44/ ! Analysis or Forecast at a horizontal or in a
data templates(30)%mappdslen /21/ ! horizontal layer at a point in time for
data templates(30)%needext /.false./ ! Aerosol
data (templates(30)%mappds(j),j=1,21)
& /1,1,2,1,-1,-4,-1,-4,1,1,1,2,1,1,2,1,-1,-4,1,-1,-4/
data templates(31)%template_num /45/ ! Individual ensemble forecast, control and
data templates(31)%mappdslen /24/ ! perturbed, at horizontal level or in a horizontal
data templates(31)%needext /.false./ ! layer at a point in time for Aerosol
data (templates(31)%mappds(j),j=1,24)
& /1,1,2,1,-1,-4,-1,-4,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1/
data templates(32)%template_num /46/ ! Ave or Accum or Extreme value at level/layer
data templates(32)%mappdslen /35/ ! in a continuous or non-continuous time interval
data templates(32)%needext /.true./ ! for Aerosol
data (templates(32)%mappds(j),j=1,35)
& /1,1,2,1,-1,-4,-1,-4,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/
data templates(33)%template_num /47/ ! Individual ensemble forecast, control and
data templates(33)%mappdslen /38/ ! perturbed, at horizontal level or in a horizontal
data templates(33)%needext /.true./ ! in a continuous or non-continuous time interval
data (templates(33)%mappds(j),j=1,38) ! for Aerosol
& /1,1,1,2,1,-1,-4,-1,-4,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1,2,1,
& 1,1,1,1,1,4,1,1,1,4,1,4/
data templates(34)%template_num /51/ ! Categorical forecasts at a horizontal level or
data templates(34)%mappdslen /16/ ! in a horizontal layer at a point in time
data templates(34)%needext /.true./
data (templates(34)%mappds(j),j=1,16)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1/
!
! PDT 4.91
!
data templates(35)%template_num /91/ ! Categorical forecasts at a horizontal level or
data templates(35)%mappdslen /36/ ! in a horizontal layer in a continuous or
data templates(35)%needext /.true./ ! non-continuous time interval
data (templates(35)%mappds(j),j=1,36)
& /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,1,1,1,4,1,1,1,4,1,4/
data templates(36)%template_num /32/ ! Analysis or forecast at a horizontal level or
data templates(36)%mappdslen /10/ ! in a horizontal layer at a point in time for
data templates(36)%needext /.true./ ! for simulate (synthetic) Satellite data
data (templates(36)%mappds(j),j=1,10)
& /1,1,1,1,1,2,1,1,4,1/
!
! PDT 4.48
!
data templates(37)%template_num /48/ ! Analysis or forecast at a horizontal level or
data templates(37)%mappdslen /26/ ! in a horizontal layer at a point in time for
data templates(37)%needext /.false./ ! Optical Properties of Aerosol
data (templates(37)%mappds(j),j=1,26)
& /1,1,2,1,-1,-4,-1,-4,1,-1,-4,-1,-4,1,1,1,2,1,1,4,1,-1,-4,
& 1,-1,-4/
!
! PDT 4.50 VALIDATION
!
data templates(38)%template_num /50/ ! Analysis or Forecast of a multi component
data templates(38)%mappdslen /21/ ! parameter or matrix element at a point in time
data templates(38)%needext /.false./ !
data (templates(38)%mappds(j),j=1,21)
& /1,1,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,4,4,4,4/
!
! PDT 4.52 VALIDATION
!
data templates(39)%template_num /52/ ! Analysis or forecast of Wave parameters
data templates(39)%mappdslen /15/ ! at the Sea surface at a point in time
data templates(39)%needext /.false./ !
data (templates(39)%mappds(j),j=1,15)
& /1,1,1,1,1,1,1,1,2,1,1,4,1,-1,-4/
!
! PDT 4.33 (07/29/2013)
!
data templates(40)%template_num /33/ ! Individual ensemble forecast, control, perturbed,
data templates(40)%mappdslen /18/ ! at a horizontal level or in a horizontal layer
data templates(40)%needext /.true./ ! at a point in time for simulate (synthetic) Satellite data
data (templates(40)%mappds(j),j=1,18)
& /1,1,1,1,1,2,1,1,4,1,2,2,2,-1,-4,1,1,1/
!
! PDT 4.34 (07/29/2013)
!
data templates(41)%template_num /34/ ! Individual ensemble forecast, control, perturbed,
data templates(41)%mappdslen /32/ ! at a horizontal level or in a horizontal layer,
data templates(41)%needext /.true./ ! in a continuous or non-continuous interval
data (templates(41)%mappds(j),j=1,32) ! for simulate (synthetic) Satellite data
& /1,1,1,1,1,2,1,1,4,1,2,2,2,-1,-4,1,1,1,2,1,1,1,
& 1,1,1,4,1,1,1,4,1,4/
!
! PDT 4.53 (07/30/2013)
!
data templates(42)%template_num /53/ ! Partitioned parameters at
data templates(42)%mappdslen /19/ ! horizontal level or horizontal layer
data templates(42)%needext /.true./ ! at a point in time
data (templates(42)%mappds(j),j=1,19)
& /1,1,1,1,4,2,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4/
!
! PDT 4.54 (07/30/2013)
!
data templates(43)%template_num /54/ ! Individual ensemble forecast, controli and perturbed,
data templates(43)%mappdslen /22/ ! at a horizontal level or in a horizontal layer
data templates(43)%needext /.true./ ! at a point in time for partitioned parameters
data (templates(43)%mappds(j),j=1,22)
& /1,1,1,1,4,2,1,1,1,2,1,1,4,1,-1,-4,1,-1,-4,1,1,1/
contains
integer function getpdsindex(number)
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! SUBPROGRAM: getpdsindex
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2001-06-28
!
! ABSTRACT: This function returns the index of specified Product
! Definition Template 4.NN (NN=number) in array templates.
!
! PROGRAM HISTORY LOG:
! 2001-06-28 Gilbert
!
! USAGE: index=getpdsindex(number)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Product Definition
! Template 4.NN that is being requested.
!
! RETURNS: Index of PDT 4.NN in array templates, if template exists.
! = -1, otherwise.
!
! REMARKS: None
!
! ATTRIBUTES:
! LANGUAGE: Fortran 90
! MACHINE: IBM SP
!
!$$$
integer,intent(in) :: number
getpdsindex=-1
do j=1,MAXTEMP
if (number.eq.templates(j)%template_num) then
getpdsindex=j
return
endif
enddo
end function
subroutine getpdstemplate(number,nummap,map,needext,iret)
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! SUBPROGRAM: getpdstemplate
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11
!
! ABSTRACT: This subroutine returns PDS template information for a
! specified Product Definition Template 4.NN.
! The number of entries in the template is returned along with a map
! of the number of octets occupied by each entry. Also, a flag is
! returned to indicate whether the template would need to be extended.
!
! PROGRAM HISTORY LOG:
! 2000-05-11 Gilbert
! 2010-08-03 VUONG - Added Templates 4.40,4.41,4.42,.4.43
! 2010-12-08 Vuong - Corrected Product Definition Template 4.42 and 4.43
! 2013-07-29 Vuong - Added Templates 4.48,4.50,4.33,4.34,4.53,4.54
!
! USAGE: CALL getpdstemplate(number,nummap,map,needext,iret)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Product Definition
! Template 4.NN that is being requested.
!
! OUTPUT ARGUMENT LIST:
! nummap - Number of entries in the Template
! map() - An array containing the number of octets that each
! template entry occupies when packed up into the PDS.
! needext - Logical variable indicating whether the Product Defintion
! Template has to be extended.
! ierr - Error return code.
! 0 = no error
! 1 = Undefine Product Template number.
!
! REMARKS: None
!
! ATTRIBUTES:
! LANGUAGE: Fortran 90
! MACHINE: IBM SP
!
!$$$
integer,intent(in) :: number
integer,intent(out) :: nummap,map(*),iret
logical,intent(out) :: needext
iret=0
index=getpdsindex(number)
if (index.ne.-1) then
nummap=templates(index)%mappdslen
needext=templates(index)%needext
map(1:nummap)=templates(index)%mappds(1:nummap)
else
nummap=0
needext=.false.
print *,'getpdstemplate: PDS Template ',number,
& ' not defined.'
iret=1
endif
end subroutine
subroutine extpdstemplate(number,list,nummap,map)
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! SUBPROGRAM: extpdstemplate
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2000-05-11
!
! ABSTRACT: This subroutine generates the remaining octet map for a
! given Product Definition Template, if required. Some Templates can
! vary depending on data values given in an earlier part of the
! Template, and it is necessary to know some of the earlier entry
! values to generate the full octet map of the Template.
!
! PROGRAM HISTORY LOG:
! 2000-05-11 Gilbert
! 2010-08-03 VUONG - Added Templates 4.40,4.41,4.42,.4.43
! 2010-12-08 Vuong - Corrected Product Definition Template 4.42 and 4.43
! 2013-07-29 Vuong - Added Templates 4.48,4.50,4.33,4.34,4.53,4.54
!
! USAGE: CALL extpdstemplate(number,list,nummap,map)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Product Definition
! Template 4.NN that is being requested.
! list() - The list of values for each entry in the
! the Product Definition Template 4.NN.
!
! OUTPUT ARGUMENT LIST:
! nummap - Number of entries in the Template
! map() - An array containing the number of octets that each
! template entry occupies when packed up into the GDS.
!
! ATTRIBUTES:
! LANGUAGE: Fortran 90
! MACHINE: IBM SP
!
!$$$
integer,intent(in) :: number,list(*)
integer,intent(out) :: nummap,map(*)
index=getpdsindex(number)
if (index.eq.-1) return
if ( .not. templates(index)%needext ) return
nummap=templates(index)%mappdslen
map(1:nummap)=templates(index)%mappds(1:nummap)
if ( number.eq.3 ) then
N=list(27)
do i=1,N
map(nummap+i)=1
enddo
nummap=nummap+N
elseif ( number.eq.4 ) then
N=list(26)
do i=1,N
map(nummap+i)=1
enddo
nummap=nummap+N
elseif ( number.eq.8 ) then
if ( list(22).gt.1 ) then
do j=2,list(22)
do k=1,6
map(nummap+k)=map(23+k)
enddo
nummap=nummap+6
enddo
endif
elseif ( number.eq.9 ) then
if ( list(29).gt.1 ) then
do j=2,list(29)
do k=1,6
map(nummap+k)=map(30+k)
enddo
nummap=nummap+6
enddo
endif
elseif ( number.eq.10 ) then
if ( list(23).gt.1 ) then
do j=2,list(23)
do k=1,6
map(nummap+k)=map(24+k)
enddo
nummap=nummap+6
enddo
endif
elseif ( number.eq.11 ) then
if ( list(25).gt.1 ) then
do j=2,list(25)
do k=1,6
map(nummap+k)=map(26+k)
enddo
nummap=nummap+6
enddo
endif
elseif ( number.eq.12 ) then
if ( list(24).gt.1 ) then
do j=2,list(24)
do k=1,6
map(nummap+k)=map(25+k)
enddo
nummap=nummap+6
enddo
endif
elseif ( number.eq.13 ) then
if ( list(38).gt.1 ) then
do j=2,list(38)
do k=1,6
map(nummap+k)=map(39+k)
enddo
nummap=nummap+6
enddo
endif
N=list(27)
do i=1,N
map(nummap+i)=1
enddo
nummap=nummap+N
elseif ( number.eq.14 ) then
if ( list(37).gt.1 ) then
do j=2,list(37)
do k=1,6
map(nummap+k)=map(38+k)
enddo
nummap=nummap+6
enddo
endif
N=list(26)
do i=1,N
map(nummap+i)=1
enddo
nummap=nummap+N
elseif ( number.eq.30 ) then
do j=1,list(5)
map(nummap+1)=2
map(nummap+2)=2
map(nummap+3)=1
map(nummap+4)=1
map(nummap+5)=4
nummap=nummap+5
enddo
elseif ( number.eq.31 ) then
do j=1,list(5)
map(nummap+1)=2
map(nummap+2)=2
map(nummap+3)=2
map(nummap+4)=1
map(nummap+5)=4
nummap=nummap+5
enddo
elseif ( number.eq.32 ) then
do j=1,list(10)
map(nummap+1)=2
map(nummap+2)=2
map(nummap+3)=2
map(nummap+4)=-1
map(nummap+5)=-4
nummap=nummap+5
enddo
elseif ( number.eq.33 ) then
N=list(10)
do i=1,N
map(nummap+i)=1
enddo
nummap=nummap+N
elseif ( number.eq.34 ) then
if ( list(25).gt.1 ) then
do j=2,list(25)
do k=1,6
map(nummap+k)=map(26+k)
enddo
nummap=nummap+6
enddo
endif
N=list(10)
do i=1,N
map(nummap+i)=1
enddo
nummap=nummap+N
elseif ( number.eq.42 ) then
if ( list(23).gt.1 ) then
do j=2,list(23)
do k=1,6
map(nummap+k)=map(24+k)
enddo
nummap=nummap+6
enddo
endif
elseif ( number.eq.43 ) then
if ( list(26).gt.1 ) then
do j=2,list(26)
do k=1,6
map(nummap+k)=map(27+k)
enddo
nummap=nummap+6
enddo
endif
elseif ( number.eq.46 ) then
if ( list(28).gt.1 ) then
do j=2,list(28)
do k=1,6
map(nummap+k)=map(29+k)
enddo
nummap=nummap+6
enddo
endif
elseif ( number.eq.47 ) then
if ( list(31).gt.1 ) then
do j=2,list(31)
do k=1,6
map(nummap+k)=map(32+k)
enddo
nummap=nummap+6
enddo
endif
elseif ( number.eq.51 ) then
do j=1,list(16)
map(nummap+1)=1
map(nummap+2)=1
map(nummap+3)=-1
map(nummap+4)=-4
map(nummap+5)=-1
map(nummap+6)=-4
nummap=nummap+6
enddo
elseif ( number.eq.53 ) then
N=list(4)
do i=1,N
map(nummap+i)=1
enddo
nummap=nummap+N
elseif ( number.eq.54 ) then
N=list(4)
do i=1,N
map(nummap+i)=1
enddo
nummap=nummap+N
elseif ( number.eq.91 ) then
if ( list(29).gt.1 ) then
do j=2,list(29)
do k=1,6
map(nummap+k)=map(30+k)
enddo
nummap=nummap+6
enddo
endif
N=list(16)
do i=1,N
map(nummap+i)=1
enddo
nummap=nummap+N
endif
end subroutine
integer function getpdtlen(number)
!$$$ SUBPROGRAM DOCUMENTATION BLOCK
! . . . .
! SUBPROGRAM: getpdtlen
! PRGMMR: Gilbert ORG: W/NP11 DATE: 2004-05-11
!
! ABSTRACT: This function returns the initial length (number of entries) in
! the "static" part of specified Product Definition Template 4.number.
!
! PROGRAM HISTORY LOG:
! 2004-05-11 Gilbert
!
! USAGE: CALL getpdtlen(number)
! INPUT ARGUMENT LIST:
! number - NN, indicating the number of the Product Definition
! Template 4.NN that is being requested.
!
! RETURNS: Number of entries in the "static" part of PDT 4.number
! OR returns 0, if requested template is not found.
!
! REMARKS: If user needs the full length of a specific template that
! contains additional entries based on values set in the "static" part
! of the PDT, subroutine extpdstemplate can be used.
!
! ATTRIBUTES:
! LANGUAGE: Fortran 90
! MACHINE: IBM SP
!
!$$$
integer,intent(in) :: number
getpdtlen=0
index=getpdsindex(number)
if (index.ne.-1) then
getpdtlen=templates(index)%mappdslen
endif
end function
end module