Pythia6Interface/src/txgive.F

0001 c----------------------------------------------------------------------------c
0002 C..TXGIVE V:1.03,   06/09/2006 by Serge Slabospitsky
0003 C rewritten from PYGIVE routine from PYTHIA
0004 C...Sets values of commonblock variables.
0005
0006       SUBROUTINE TXGIVE(CHIN)
0007       implicit none
0008       Integer           Ipar     ! global TopRex integer parameters
0009       double precision  Rpar     ! global TopRex real    parameters
0010       common /TXPAR/Ipar(512), Rpar(512)
0011       save   /TXPAR/
0012 ***
0013       integer CSAMODE
0014       integer pad
0015       double precision  MUONRW, GAMMAJRW, ZJRW, ZPRW, HLTRW,
0016      &  SUSYRW, WWRW, PTPOWER
0017       common /EXPAR/ pad, CSAMODE, MUONRW, GAMMAJRW, ZJRW, ZPRW,
0018      &  HLTRW, SUSYRW, WWRW, PTPOWER
0019
0020       save   /EXPAR/
0021 **********
0022       integer ndch   ! maximum number of decay channels
0023       parameter (ndch=50)
0024       integer        MID(0:ndch,4),             FID(4,ndch,5)
0025       double precision   wid(0:ndch,4),brf(ndch,4),     BRS(2,4)
0026       common /TXdec/ MID, WID,         BRF,     FID,    brs
0027       save   /TXdec/
0028 *...........
0029       integer  maxpro
0030       parameter (maxpro=500)
0031       integer         txmup, txsel, txpro,         txext
0032       common /trxpro/ txmup, txsel, txpro(maxpro), txext(maxpro)
0033       save   /trxpro/
0034 *............
0035       integer Irtyp
0036       double precision an_FL,an_FR,an_HL,an_HR,an_XL,an_XR,an_YL,an_YR
0037       common /CTOPINI/Irtyp(20), an_FL(2,20), an_FR(2,20),
0038      &   an_HL(2,20), an_HR(2,20), an_XL(2,20), an_XR(2,20),
0039      &   an_YL(2,20), an_YR(2,20)
0040       save /CTOPINI/
0041 ***
0042       integer IER, I, J, IL, k1, k2 , Iread
0043       integer lenk
0044       parameter (lenk=512)
0045       character *(*) chin
0046       character *60 inam, rnam
0047       character *20 cvi  ! , cvj
0048       character *512 STRIN
0049       character *512 strin2
0050       data strin2/'PROCESS : not given'/
0051       save strin2
0052
0053 *   for TAUOLA package
0054       integer            PJAK1, PJAK2, MDTAU
0055       common /ki_taumod/ PJAK1, PJAK2, MDTAU
0056       data pjak1/-1/, pjak2/ -1/, mdtau/-1/
0057       save /ki_taumod/
0058 *
0059       character*512                            CXpar
0060       integer         Ixpar
0061       double precision            RXpar
0062       common /EXGPAR/ IXpar(100), RXpar(100), CXpar(100)
0063       data IXpar/1, 99*0/
0064       save /EXGPAR/
0065       logical first
0066       data first /.TRUE./
0067       save first
0068 ****
0069 *
0070 * read name of the process
0071 *
0072       IF(first.EQV..TRUE.) then
0073         first=.FALSE.
0074            do j = 1,100
0075              do i = 1,lenk
0076               cxpar(j)(i:i) = ' '
0077              enddo
0078             enddo
0079       ENDIF
0080 ***
0081       Iread = 1
0082       ier = 1
0083 ***
0084
0085       Inam = 'CSAMODE ='
0086         call TXRSTR2(inam, chin, strin, ier)
0087 C       print*,'IER', ier
0088          if(ier.ne.1) then
0089            iread = 0
0090            read(strin(1:512),*) CSAMODE
0091          endif
0092 *
0093
0094       rnam = 'MUONRW ='
0095         call TXRSTR2(rnam, chin, strin, ier)
0096 C       print*,'IER', ier
0097          if(ier.ne.1) then
0098            iread = 0
0099            read(strin(1:512),*) MUONRW
0100          endif
0101 *
0102
0103       rnam = 'GAMMAJRW ='
0104         call TXRSTR2(rnam, chin, strin, ier)
0105 C       print*,'IER', ier
0106          if(ier.ne.1) then
0107            iread = 0
0108            read(strin(1:512),*) GAMMAJRW
0109          endif
0110 *
0111
0112       rnam = 'ZJRW ='
0113         call TXRSTR2(rnam, chin, strin, ier)
0114 C       print*,'IER', ier
0115          if(ier.ne.1) then
0116            iread = 0
0117            read(strin(1:512),*) ZJRW
0118          endif
0119 *
0120       rnam = 'ZPRW ='
0121         call TXRSTR2(rnam, chin, strin, ier)
0122 C       print*,'IER', ier
0123          if(ier.ne.1) then
0124            iread = 0
0125            read(strin(1:512),*) ZPRW
0126          endif
0127 *
0128       rnam = 'HLTRW ='
0129         call TXRSTR2(rnam, chin, strin, ier)
0130 C       print*,'IER', ier
0131          if(ier.ne.1) then
0132            iread = 0
0133            read(strin(1:512),*) HLTRW
0134          endif
0135 *
0136       rnam = 'SUSYRW ='
0137         call TXRSTR2(rnam, chin, strin, ier)
0138 C       print*,'IER', ier
0139          if(ier.ne.1) then
0140            iread = 0
0141            read(strin(1:512),*) SUSYRW
0142          endif
0143 *
0144       rnam = 'WWRW ='
0145         call TXRSTR2(rnam, chin, strin, ier)
0146 C       print*,'IER', ier
0147          if(ier.ne.1) then
0148            iread = 0
0149            read(strin(1:512),*) WWRW
0150          endif
0151
0152       rnam = 'PTPOWER ='
0153         call TXRSTR2(rnam, chin, strin, ier)
0154 C       print*,'IER', ier
0155          if(ier.ne.1) then
0156            iread = 0
0157            read(strin(1:512),*) PTPOWER
0158          endif
0159
0160 ***
0161
0162       do I = 1,512
0163         call intochar(I, il, cvi)
0164          Inam = 'ipar('//cvi(1:il)//')'//' = '
0165          Rnam = 'rpar('//cvi(1:il)//')'//' = '
0166         call TXRSTR2(rnam, chin, strin, ier)
0167          if(ier.ne.1) then
0168            iread = 0
0169            read(strin(1:512),*) Rpar(i)
0170          endif
0171         call TXRSTR2(inam, chin, strin, ier)
0172          if(ier.ne.1) then
0173            iread = 0
0174            read(strin(1:512),*) Ipar(i)
0175          endif
0176       enddo
0177 *
0178 ***
0179 *
0180       Inam = 'unwfile = ' ! for alpgen
0181         call TXRSTR2(inam, chin, strin, ier)
0182          if(ier.eq.0) then
0183            Iread = 0
0184            call strnum(chin, k1, k2)
0185             if(k1.ge.1.and.k2.ge.k1) then
0186                 do i = 1,lenk
0187                  cxpar(1)(i:i) = ' '
0188                 enddo
0189              ixpar(99) = k2 - k1 + 1
0190              ixpar(100) = ixpar(99) + 1
0191              cxpar(1)(1:ixpar(99)) = chin(k1:k2)
0192             endif
0193 *        print*,'UNFILE k1 k2 cxpar ',k1,k2,cxpar(1)
0194          endif
0195 ***
0196       Inam = 'evfile = '        ! for Madgraph and CompHEP
0197         call TXRSTR2(inam, chin, strin, ier)
0198          if(ier.eq.0) then
0199             Iread = 0
0200           call strnum(chin, k1, k2)
0201             if(k1.ge.1.and.k2.ge.k1) then
0202                 do i = 1,lenk
0203                  cxpar(1)(i:i) = ' '
0204                 enddo
0205              ixpar(99) = k2 - k1 + 1
0206               cxpar(1)(1:ixpar(99)) = chin(k1:k2)
0207 *            cxpar(1) = chin(k1:k2)
0208              ixpar(100) = k2 - k1 + 2
0209             endif
0210 *        print*,'EVFILE k1 k2 cxpar ',k1,k2,cxpar(1)
0211          endif
0212 *
0213       Inam = 'PROCESS = '
0214         call TXRSTR2(inam, chin, strin, ier)
0215 *        print*,'** IER ' ,ier,' process ',chin
0216          if(ier.eq.0) then
0217             Iread = 0
0218            do i = 1,lenk
0219              cxpar(2)(i:i) = ' '
0220              strin2(i:i) = ' '
0221             enddo
0222            strin2 = chin
0223 *           cxpar(2) = chin
0224 *           print*,cxpar(2)
0225           endif
0226            cxpar(2) = strin2
0227 *
0228       do I = 1,100
0229        call intochar(I, il, cvi)
0230         Rnam = 'rxpar('//cvi(1:il)//')'//' = '
0231         call TXRSTR2(rnam, chin, strin, ier)
0232          if(ier.eq.0) Iread = 0
0233          if(ier.eq.0) read(strin(1:lenk),*) RXpar(i)
0234         Inam = 'ixpar('//cvi(1:il)//')'//' = '
0235         call TXRSTR2(inam, chin, strin, ier)
0236          if(ier.eq.0) read(strin(1:lenk),*) IXpar(i)
0237          if(ier.eq.0) Iread = 0
0238       enddo
0239 *
0240       do I = 1,200
0241         call intochar(I, il, cvi)
0242          Inam = 'ipar('//cvi(1:il)//')'//' = '
0243          Rnam = 'rpar('//cvi(1:il)//')'//' = '
0244         call TXRSTR2(rnam, chin, strin, ier)
0245          if(ier.eq.0) read(strin(1:lenk),*) Rpar(i)
0246         if(ier.eq.0) Iread = 0
0247         call TXRSTR2(inam, chin, strin, ier)
0248          if(ier.eq.0) read(strin(1:lenk),*) Ipar(i)
0249         if(ier.eq.0) Iread = 0
0250       enddo
0251 *
0252          Inam = 'txsel '//' = '
0253         call TXRSTR2(inam, chin, strin, ier)
0254         if(ier.eq.0) read(strin(1:lenk),*) txsel
0255         if(ier.eq.0) Iread = 0
0256       do I = 1, maxpro
0257         call intochar(I, il, cvi)
0258         Inam = 'txpro('//cvi(1:il)//')'//' = '
0259         call TXRSTR2(inam, chin, strin, ier)
0260         if(ier.eq.0) read(strin(1:lenk),*) txpro(i)
0261         if(ier.eq.0) Iread = 0
0262       enddo
0263 * read decay channels
0264 *     IT = 1 : top quark,  IT = 2 : W-boson,
0265 *     IT = 3 : H+- boson,  IT = 4 : Z-boson
0266       do I = 1, ndch
0267         call intochar(I, il, cvi)
0268 *  top quark
0269          inam = 'dectop('//cvi(1:il)//') ='
0270          call TXRSTR2(inam, chin, strin, ier)
0271          if(ier.eq.0) read(strin(1:lenk),*) mid(i, 1)
0272         if(ier.eq.0) Iread = 0
0273 *  H+- boson
0274          inam = 'dechpm('//cvi(1:il)//') ='
0275          call TXRSTR2(inam, chin, strin, ier)
0276          if(ier.eq.0) read(strin(1:lenk),*) mid(i, 3)
0277          if(ier.eq.0) Iread = 0
0278 *  W-boson
0279          inam = 'decwpm('//cvi(1:il)//') ='
0280          call TXRSTR2(inam, chin, strin, ier)
0281          if(ier.eq.0) read(strin(1:lenk),*) mid(i, 2)
0282          if(ier.eq.0) Iread = 0
0283 *  Z-boson
0284          inam = 'decZ0('//cvi(1:il)//') ='
0285          call TXRSTR2(inam, chin, strin, ier)
0286          if(ier.eq.0) read(strin(1:lenk),*) mid(i, 4)
0287          if(ier.eq.0) Iread = 0
0288       enddo
0289
0290       do I = 1,20
0291         call intochar(I, il, cvi)
0292         inam = 'Irtyp('//cvi(1:il)//') ='
0293         call TXRSTR2(inam, chin, strin, ier)
0294          if(ier.eq.0) read(strin(1:lenk),*) irtyp(i)
0295          if(ier.eq.0) Iread = 0
0296       enddo
0297 ****
0298       do I = 1,20
0299         call intochar(I, il, cvi)
0300 *
0301 * FL
0302         ier = 1
0303          inam = 'an_fl('//cvi(1:il)//') ='
0304          call TXRSTR2(inam, chin, strin, ier)
0305         if(ier.eq.0) read(strin(1:lenk),*) an_fl(1,i), an_fl(2,i)
0306         if(ier.eq.0) Iread = 0
0307 * FR
0308         ier = 1
0309          inam = 'an_fr('//cvi(1:il)//') ='
0310          call TXRSTR2(inam, chin, strin, ier)
0311         if(ier.eq.0) read(strin(1:lenk),*) an_fr(1,i), an_fr(2,i)
0312         if(ier.eq.0) Iread = 0
0313 *** HL
0314         ier = 1
0315          inam = 'an_hl('//cvi(1:il)//') ='
0316          call TXRSTR2(inam, chin, strin, ier)
0317         if(ier.eq.0) read(strin(1:lenk),*) an_hl(1,i), an_hl(2,i)
0318         if(ier.eq.0) Iread = 0
0319 * HR
0320         ier = 1
0321           inam = 'an_hr('//cvi(1:il)//') ='
0322           call TXRSTR2(inam, chin, strin, ier)
0323         if(ier.eq.0) read(strin(1:lenk),*) an_hr(1,i), an_hr(2,i)
0324         if(ier.eq.0) Iread = 0
0325 *** XL
0326         ier = 1
0327          inam = 'an_xl('//cvi(1:il)//') ='
0328           call TXRSTR2(inam, chin, strin, ier)
0329         if(ier.eq.0) read(strin(1:lenk),*) an_xl(1,i), an_xl(2,i)
0330         if(ier.eq.0) Iread = 0
0331 * XR
0332         ier = 1
0333           inam = 'an_xr('//cvi(1:il)//') ='
0334           call TXRSTR2(inam, chin, strin, ier)
0335         if(ier.eq.0) read(strin(1:lenk),*) an_xr(1,i), an_xr(2,i)
0336         if(ier.eq.0) Iread = 0
0337 *** YL
0338         ier = 1
0339          inam = 'an_yl('//cvi(1:il)//') ='
0340          call TXRSTR2(inam, chin, strin, ier)
0341         if(ier.eq.0) read(strin(1:lenk),*) an_yl(1,i), an_yl(2,i)
0342         if(ier.eq.0) Iread = 0
0343 * YR
0344         ier = 1
0345          inam = 'an_yr('//cvi(1:il)//') ='
0346          call TXRSTR2(inam, chin, strin, ier)
0347         if(ier.eq.0) read(strin(1:lenk),*) an_yr(1,i), an_yr(2,i)
0348         if(ier.eq.0) Iread = 0
0349       enddo
0350 * read TAUOLA parameters
0351        ier = 1
0352        inam = 'tauola ='
0353        call TXRSTR2(inam, chin, strin, ier)
0354        if(ier.eq.0) read(strin(1:lenk),*) pjak1, pjak2, mdtau
0355        if(ier.eq.0) Iread = 0
0356 ****
0357       IF(IXpar(1).eq.1.OR.IXpar(1).eq.2) then
0358         if(Iread.eq.0) return
0359         k1 = 0
0360         k2 = 0
0361       do i = 1,lenk
0362        If(k1.eq.0.AND.
0363      &  (ichar(chin(i:i)).ge.33.and.
0364      &   ichar(chin(i:i)).le.126)) then
0365           k1 = i
0366         EndIf
0367          if(chin(i:i).eq.'=') then
0368            k2 = i
0369            goto 152
0370          endif
0371       enddo
0372  152  continue
0373        if(k1.eq.0.or.k2.eq.0) then
0374          print*,'TXGIVE: do not recognize input : ',chin
0375        else
0376         if(k2.eq.0) k2 = lenk
0377          k2 = k2 - 1
0378          print*,'TXGIVE: do not recognize input parameter : ',
0379      &    chin(k1:k2)
0380        endif
0381        if(IXpar(1).eq.2) then
0382          print*,'STOP '
0383          stop
0384        endif
0385       ENDIF
0386       return
0387       end
0388 *----------------------------------------------------------------------------*
0389 C..INTOCHAR, 06/09/2006 by Serge Slabospitsky
0390       subroutine intochar(IV, JL, CV)
0391
0392       implicit none
0393       character *20 cv
0394       integer IV, JL, i1, i2, J
0395 *
0396       jl = 0
0397       if(iv.lt.0) return
0398       JL = 1
0399       I1 = IV
0400       I2 = i1 - 10*int(i1/10)
0401       CV(1:1) = char(i2 + 48)
0402       if(i1.le.9) return
0403  1000 continue
0404        JL = jl + 1
0405        i1 = i1/10
0406        i2 = i1 - 10*int(i1/10)
0407        do j=2,jl
0408         cv((jl+2-j):(jl+2-j)) = cv((jl+1-j):(jl+1-j))
0409        enddo
0410        CV(1:1) = char(i2 + 48)
0411        if(i1.le.9) return
0412       goto 1000
0413       end
0414 c----------------------------------------------------------------------------c
0415 C..TXRSTR2, 06/09/2006 by Serge Slabospitsky
0416 *                                                                            *
0417       SUBROUTINE TXRSTR2(inam, aa, strout, ier)
0418 *     ------------------------------------                                   *
0419 * input : INAM is character string (up to 40 symbols) with '=' as the end    *
0420 * outout: STROUT is character string with value (values)                     *
0421 *         IER = 0 (1) variable is readed and returned                        *
0422 *............................................................................*
0423       implicit none
0424       integer IER, I, j1, jj
0425       integer lens
0426       parameter (lens=60)
0427       integer lenk
0428       parameter (lenk=512)
0429       character *512 strout, aa, vnu
0430 *
0431       character *60 inam, vv, vst, ww
0432 *
0433        do i = 1,lenk
0434         strout(i:i) = ' '
0435        enddo
0436       ier = 1
0437        do i = 1,lenk
0438         if(aa(i:i).ne.' ') then
0439          j1 = 1  ! non-blank character
0440          if(aa(i:i).eq.'*') goto 200   ! first non-blank item = '*' -  comment
0441          goto 16
0442         endif
0443        enddo
0444         goto 200 !  blank string
0445  16    j1 = 0
0446        do i = 1,lenk
0447         if(aa(i:i).ne.' ') then
0448            if(aa(i:i).eq.'='.and.j1.eq.0) then
0449             j1 = i
0450             goto 17
0451            endif
0452         endif
0453       enddo
0454        goto 200
0455  17    jj = 0
0456        do i = 1,(j1-1)
0457        if(aa(i:i).ne.' ') then
0458        jj = jj + 1
0459         if(ichar(aa(i:i)).ge.65.AND.ichar(aa(i:i)).LE.90) then
0460            vv(jj:jj) = char(ichar(aa(i:i))+32)
0461          else
0462            vv(jj:jj) = aa(i:i)
0463          endif
0464         endif
0465         enddo
0466         vst(1:jj) = vv(1:jj)
0467         vnu = aa((j1+1):lenk)
0468 **
0469       j1 = 0
0470       do i=1,lens
0471         if(inam(i:i).eq.'='.and.j1.eq.0) j1 = i
0472       enddo
0473       if(j1.eq.0) return
0474 * remove blank characters and transform capital letters to small ones
0475        jj = 0
0476        do i = 1,(j1-1)
0477        if(inam(i:i).ne.' ') then
0478        jj = jj + 1
0479         if(ichar(inam(i:i)).ge.65.AND.ichar(inam(i:i)).LE.90) then
0480            vv(jj:jj) = char(ichar(inam(i:i))+32)
0481          else
0482            vv(jj:jj) = inam(i:i)
0483          endif
0484         endif
0485         enddo
0486
0487         ww(1:jj) = vv(1:jj)
0488        j1 = jj
0489
0490          vv = vst
0491          IF(ww(1:j1).eq.vv(1:j1)) THEN
0492              IER = 0
0493              strout(1:lenk) = vnu(1:lenk)
0494              return
0495          ENDIF
0496  200    IER = 1
0497       return
0498       END
0499 *----------------------------------------------------------------------------c
0500 * STRNUM, 06/09/2006 by Serge Slabospitsky
0501 *                                                                            *
0502       subroutine strnum(aa, k1, k2)
0503 *     ------------------------------------                                   *
0504 * input : AA is character string (up to 40 symbols) with '=' as the end      *
0505 * outout: k1 and k2 are the positions in AA of the first and last characters *
0506 * in the input string after '=' sign. K1 = K2 = 0 if not found               *
0507 *............................................................................*
0508       implicit none
0509       integer  i, k1, k2, lenk
0510       parameter (lenk=132)
0511       character *132 aa
0512 *
0513       k1 = 0
0514       k2 = 0
0515       i = 0
0516  51   i = i + 1
0517       if(i.ge.lenk) goto 59
0518        If(k1.eq.0) then
0519         if(aa(i:i).eq.'=') k1 = i
0520        Elseif(k1.ge.1) then
0521         if(ichar(aa(i:i)).ge.33.and.
0522      &     ichar(aa(i:i)).le.126) then
0523           k1 = i
0524           goto 52
0525         endif
0526        EndIf
0527        goto 51
0528        if(k1.eq.0) goto 59
0529  52   k2 = 0
0530       i = k1
0531  53   i = i + 1
0532        if(i.ge.lenk) goto 59
0533         if(ichar(aa(i:i)).ge.33.and.
0534      &     ichar(aa(i:i)).le.126) goto 53
0535          k2 = i-1
0536          if(k2.eq.0.or.k2.gt.lenk) k2 = 0
0537  59   return
0538       end
0539 c----------------------------------------------------------------------------c
0540 C..TXGIVE V:1.03,   01/09/2006 by Filip Moortgat
0541
0542       SUBROUTINE TXGIVE_INIT
0543
0544       implicit none
0545
0546       integer CSAMODE
0547       integer pad
0548       double precision  MUONRW, GAMMAJRW, ZJRW, ZPRW, HLTRW,
0549      &  SUSYRW, WWRW, PTPOWER
0550       common /EXPAR/ pad, CSAMODE, MUONRW, GAMMAJRW, ZJRW, ZPRW,
0551      &  HLTRW, SUSYRW, WWRW, PTPOWER
0552       save   /EXPAR/
0553
0554
0555       CSAMODE = 0
0556       pad = 0
0557       MUONRW = -1
0558       GAMMAJRW = -1
0559       ZJRW = -1
0560       ZPRW = -1
0561       HLTRW = -1
0562       SUSYRW = -1
0563       WWRW = -1
0564       PTPOWER = 0
0565
0566
0567       END
0568 *----------------------------------------------------------------------------c