drstemplates.f

Go to the documentation of this file.

 
 
      module drstemplates
 
      integer,parameter :: maxlen=200
      integer,parameter :: maxtemp=9
 
 
      type drstemplate
          integer :: template_num
          integer :: mapdrslen
          integer,dimension(MAXLEN) :: mapdrs
          logical :: needext
      end type drstemplate
 
      type(drstemplate),dimension(MAXTEMP) :: templates
 
      data templates(1)%template_num /0/     
      data templates(1)%mapdrslen /5/ 
      data templates(1)%needext /.false./
      data (templates(1)%mapdrs(j),j=1,5) 
     &                             /4,-2,-2,1,1/
 
      data templates(2)%template_num /2/     
      data templates(2)%mapdrslen /16/
      data templates(2)%needext /.false./
      data (templates(2)%mapdrs(j),j=1,16)
     &                        /4,-2,-2,1,1,1,1,4,4,4,1,1,4,1,4,1/
 
      data templates(3)%template_num /3/     
      data templates(3)%mapdrslen /18/
      data templates(3)%needext /.false./
      data (templates(3)%mapdrs(j),j=1,18)
     &                        /4,-2,-2,1,1,1,1,4,4,4,1,1,4,1,4,1,1,1/
 
      data templates(4)%template_num /50/     
      data templates(4)%mapdrslen /5/
      data templates(4)%needext /.false./
      data (templates(4)%mapdrs(j),j=1,5)
     &                         /4,-2,-2,1,4/
 
      data templates(5)%template_num /51/    
      data templates(5)%mapdrslen /10/
      data templates(5)%needext /.false./
      data (templates(5)%mapdrs(j),j=1,10)
     &                         /4,-2,-2,1,-4,2,2,2,4,1/
 
      data templates(6)%template_num /40000/     
      data templates(6)%mapdrslen /7/ 
      data templates(6)%needext /.false./
      data (templates(6)%mapdrs(j),j=1,7) 
     &                             /4,-2,-2,1,1,1,1/
 
      data templates(7)%template_num /40010/     
      data templates(7)%mapdrslen /5/ 
      data templates(7)%needext /.false./
      data (templates(7)%mapdrs(j),j=1,5) 
     &                             /4,-2,-2,1,1/
 
      data templates(8)%template_num /40/     
      data templates(8)%mapdrslen /7/ 
      data templates(8)%needext /.false./
      data (templates(8)%mapdrs(j),j=1,7) 
     &                             /4,-2,-2,1,1,1,1/
 
      data templates(9)%template_num /41/     
      data templates(9)%mapdrslen /5/ 
      data templates(9)%needext /.false./
      data (templates(9)%mapdrs(j),j=1,5) 
     &                             /4,-2,-2,1,1/
 
!         data templates(5)%template_num /1/      !<     Simple Packing - Matrix
!         data templates(5)%mapdrslen /15/ 
!         data templates(5)%needext /.true./
!         data (templates(5)%mapdrs(j),j=1,15)
!        &                        /4,-2,-2,1,1,1,4,2,2,1,1,1,1,1,1/
 
 
      contains
 
 
         integer function getdrsindex(number)
           integer,intent(in) :: number
 
           getdrsindex=-1
 
           do j=1,maxtemp
              if (number.eq.templates(j)%template_num) then
                 getdrsindex=j
                 return
              endif
           enddo
 
         end function
 
 
         subroutine getdrstemplate(number,nummap,map,needext,iret)
           integer,intent(in) :: number
           integer,intent(out) :: nummap,map(*),iret
           logical,intent(out) :: needext
 
           iret=0
 
           index=getdrsindex(number)
 
           if (index.ne.-1) then
              nummap=templates(index)%mapdrslen
              needext=templates(index)%needext
              map(1:nummap)=templates(index)%mapdrs(1:nummap)
           else
             nummap=0
             needext=.false.
             print *,'getdrstemplate: DRS Template ',number,
     &               ' not defined.'
             iret=1
           endif
 
         end subroutine
 
 
         subroutine extdrstemplate(number,list,nummap,map)
           integer,intent(in) :: number,list(*)
           integer,intent(out) :: nummap,map(*)
 
           index=getdrsindex(number)
           if (index.eq.-1) return
 
           if ( .not. templates(index)%needext ) return
           nummap=templates(index)%mapdrslen
           map(1:nummap)=templates(index)%mapdrs(1:nummap)
 
           if ( number.eq.1 ) then
              n=list(11)+list(13)
              do i=1,n
                map(nummap+i)=4
              enddo
              nummap=nummap+n
           endif
 
         end subroutine
 
      end module