pdstemplates.f

Go to the documentation of this file.

 
 
 
      module pdstemplates
 
      integer,parameter :: maxlen=200
      integer,parameter :: 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)
 
           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)
 
           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)
 
           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)
 
           integer,intent(in) :: number
 
           getpdtlen=0
 
           index=getpdsindex(number)
 
           if (index.ne.-1) then
              getpdtlen=templates(index)%mappdslen
           endif
 
         end function
 
      end module