bin/BCVEGPY/initmixgrade.F

0001
0002 c*

0003 c** initialize the grade to derive the mixed events.

0004 c*

0005
0006       subroutine initmixgrade
0007       implicit double precision(a-h, o-z)
0008         implicit integer(i-n)
0009
0010 #include "invegas.h"
0011 #include "bcvegpy_set_par.inc"
0012
0013         common/mixevnt/xbcsec(8),imix,imixtype
0014         common/mixevnt2/xbcsum,ibclimit
0015         common/grade/xi(NVEGBIN,10)
0016       common/counter/ibcstate,nev
0017       common/loggrade/ievntdis,igenerate,ivegasopen,igrade
0018       logical usegrade,usevegas
0019
0020          usegrade=.false.
0021          if(igrade.eq.1) usegrade=.true.
0022          usevegas=.false.
0023          if(ivegasopen.eq.1) usevegas=.true.
0024
0025 c*********************************************************

0026 c*** define which state to be generated next .

0027 c*********************************************************

0028            if(imixtype.eq.1.or.imixtype.eq.2) ibcstate=0
0029            if(imixtype.eq.3) ibcstate=2
0030
0031            ranbc=xbcsum*pyr(0)
0032 55         ibcstate=ibcstate+1
0033            ranbc =ranbc-xbcsec(ibcstate)
0034            if(ibcstate.lt.ibclimit .and. ranbc.gt.1.0d-16) go to 55
0035
0036 c----------------------

0037            if(ibcstate.eq.1 .or. ibcstate.eq.2) then
0038                call paraswave(ibcstate)
0039            end if
0040            if(ibcstate.gt.2 .and. ibcstate.lt.7) then
0041                call parapwave
0042            end if
0043            if(ibcstate.eq.7 .or. ibcstate.eq.8) then
0044                call paraswave(ibcstate)
0045            end if
0046
0047 c------------------------------------------------------------

0048 c...the following way to generate the mixed events are not

0049 c...appreciable, list here only for completeness of the program.

0050 c...rough idea to achieve such case: adding/reading the total cross-

0051 c...sections for all the states to be mixed, and then select a

0052 c...particular state to be generate with

0053 c...its corresponding cross-section, and then define a uniform

0054 c...grade for every state.

0055 c------------------------------------------------------------

0056            if((.not. usevegas) .and. (.not. usegrade)) then
0057 c...initialize the grade.

0058              ndim=7     ! fix for uninizialized variable
0059              rc=1.0d0/NVEGBIN
0060              do 77 j=1,ndim
0061                xi(NVEGBIN,j)=1.0d0
0062                dr=0.0d0
0063              do 77 i=1,NVEGBIN-1
0064                dr=dr+rc
0065                xi(i,j)=dr
0066 77           continue
0067              if(ibcstate.eq.7) ibcstate=1
0068              if(ibcstate.eq.8) ibcstate=2
0069              return
0070            end if
0071
0072 c**********************************************************

0073 c**********************************************************

0074 c*** since not using vegas and not using grade has been

0075 c*** returned, so the following can be introduced without

0076 c*** if conditions.

0077 c**********************************************************

0078 c**********************************************************

0079
0080                    if(ibcstate.eq.1) then
0081                        do i=1,NVEGBIN
0082                      read(36,*) (xi(i,j),j=1,7)
0083                    end do
0084                      rewind(36)
0085                    end if
0086
0087 c***************************************

0088                    if(ibcstate.eq.2) then
0089                        do i=1,NVEGBIN
0090                      read(37,*) (xi(i,j),j=1,7)
0091                    end do
0092                      rewind(37)
0093                    end if
0094
0095 c***************************************

0096                    if(ibcstate.eq.3) then
0097                        do i=1,NVEGBIN
0098                      read(38,*) (xi(i,j),j=1,7)
0099                    end do
0100                      rewind(38)
0101                    end if
0102
0103 c***************************************

0104                    if(ibcstate.eq.4) then
0105                        do i=1,NVEGBIN
0106                      read(39,*) (xi(i,j),j=1,7)
0107                    end do
0108                      rewind(39)
0109                    end if
0110
0111 c***************************************

0112                    if(ibcstate.eq.5) then
0113                        do i=1,NVEGBIN
0114                      read(46,*) (xi(i,j),j=1,7)
0115                    end do
0116                      rewind(46)
0117                    end if
0118
0119 c***************************************

0120                    if(ibcstate.eq.6) then
0121                        do i=1,NVEGBIN
0122                      read(47,*) (xi(i,j),j=1,7)
0123                    end do
0124                      rewind(47)
0125                    end if
0126
0127 c***************************************

0128                    if(ibcstate.eq.7) then
0129                       ibcstate=1   !1s0 and color-octet
0130                       do i=1,NVEGBIN
0131                        read(48,*) (xi(i,j),j=1,7)
0132                       end do
0133                       rewind(48)
0134                    end if
0135
0136 c***************************************

0137                    if(ibcstate.eq.8) then
0138                       ibcstate=2   !3s1 and color-octet
0139                       do i=1,NVEGBIN
0140                        read(49,*) (xi(i,j),j=1,7)
0141                       end do
0142                       rewind(49)
0143                    end if
0144       end