pyonof.f

Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pyonof.f

 
C*********************************************************************
 
C...PYONOF
C...Switches on and off decay channel by search for match.
 
      SUBROUTINE pyonof(CHIN)
 
C...Double precision and integer declarations.
      IMPLICIT DOUBLE PRECISION(a-h, o-z)
      IMPLICIT INTEGER(i-n)
      INTEGER pyk,pychge,pycomp
C...Commonblocks.
      common/pydat1/mstu(200),paru(200),mstj(200),parj(200)
      common/pydat3/mdcy(500,3),mdme(8000,2),brat(8000),kfdp(8000,5)
      SAVE /pydat1/,/pydat3/
C...Local arrays and character variables.
      INTEGER kfcmp(10),kftmp(10)
      CHARACTER chin*(*),chtmp*104,chfix*104,chmode*10,chcode*8,
     &chalp(2)*26
      DATA chalp/'abcdefghijklmnopqrstuvwxyz',
     &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/

C...Determine length of character variable.
      chtmp=chin//' '
      lbeg=0
  100 lbeg=lbeg+1
      IF(chtmp(lbeg:lbeg).EQ.' ') goto 100
      lend=lbeg-1
  105 lend=lend+1
      IF(lend.LE.100.AND.chtmp(lend:lend).NE.'!') goto 105
  110 lend=lend-1
      IF(chtmp(lend:lend).EQ.' ') goto 110
      len=1+lend-lbeg
      chfix(1:len)=chtmp(lbeg:lend)

C...Find colon separator and particle code.
      lcolon=0
  120 lcolon=lcolon+1
      IF(chfix(lcolon:lcolon).NE.':') goto 120
      chcode=' '
      chcode(10-lcolon:8)=chfix(1:lcolon-1)
      READ(chcode,'(I8)',err=300) kf
      kc=pycomp(kf)

C...Done if unknown code or no decay channels.
      IF(kc.EQ.0) THEN
        CALL pyerrm(18,'(PYONOF:) unrecognized particle '//chcode)
        RETURN
      ENDIF
      idcbeg=mdcy(kc,2)
      idclen=mdcy(kc,3)
      IF(idcbeg.EQ.0.OR.idclen.EQ.0) THEN
        CALL pyerrm(18,'(PYONOF:) no decay channels for '//chcode)
        RETURN
      ENDIF

C...Find command name up to blank or equal sign.
      lsep=lcolon
  130 lsep=lsep+1
      IF(lsep.LE.len.AND.chfix(lsep:lsep).NE.' '.AND.
     &chfix(lsep:lsep).NE.'=') goto 130
      chmode=' '
      lmode=lsep-lcolon-1
      chmode(1:lmode)=chfix(lcolon+1:lsep-1)

C...Convert to uppercase.
      DO 150 lcom=1,lmode
        DO 140 lalp=1,26
          IF(chmode(lcom:lcom).EQ.chalp(1)(lalp:lalp)) 
     &    chmode(lcom:lcom)=chalp(2)(lalp:lalp)
  140   CONTINUE
  150 CONTINUE

C...Identify command. Failed if not identified.
      mode=0
      IF(chmode.EQ.'ALLOFF') mode=1
      IF(chmode.EQ.'ALLON') mode=2
      IF(chmode.EQ.'OFFIFANY') mode=3
      IF(chmode.EQ.'ONIFANY') mode=4
      IF(chmode.EQ.'OFFIFALL') mode=5
      IF(chmode.EQ.'ONIFALL') mode=6
      IF(chmode.EQ.'OFFIFMATCH') mode=7
      IF(chmode.EQ.'ONIFMATCH') mode=8
      IF(mode.EQ.0) THEN
        CALL pyerrm(18,'(PYONOF:) unknown command '//chmode)
        RETURN
      ENDIF

C...Simple cases when all on or all off.
      IF(mode.EQ.1.OR.mode.EQ.2) THEN
        WRITE(mstu(11),1000) kf,chmode
        DO 160 idc=idcbeg,idcbeg+idclen-1
          IF(mdme(idc,1).LT.0) goto 160
          mdme(idc,1)=mode-1
  160   CONTINUE
        RETURN
      ENDIF

C...Identify matching list.
      ncmp=0
      lbeg=lsep
  170 lbeg=lbeg+1
      IF(lbeg.GT.len) goto 190
      IF(lbeg.LT.len.AND.(chfix(lbeg:lbeg).EQ.' '.OR.
     &chfix(lbeg:lbeg).EQ.'='.OR.chfix(lbeg:lbeg).EQ.',')) goto 170
      lend=lbeg-1
  180 lend=lend+1
      IF(lend.LT.len.AND.chfix(lend:lend).NE.' '.AND.
     &chfix(lend:lend).NE.'='.AND.chfix(lend:lend).NE.',') goto 180
      IF(lend.LT.len) lend=lend-1
      chcode=' '
      chcode(8-lend+lbeg:8)=chfix(lbeg:lend)
      READ(chcode,'(I8)',err=300) kfread
      ncmp=ncmp+1
      kfcmp(ncmp)=iabs(kfread)
      lbeg=lend
      IF(ncmp.LT.10) goto 170
  190 CONTINUE
      WRITE(mstu(11),1100) kf,chmode,(kfcmp(icmp),icmp=1,ncmp)

C...Only one matching required.
      IF(mode.EQ.3.OR.mode.EQ.4) THEN
        DO 220 idc=idcbeg,idcbeg+idclen-1
          IF(mdme(idc,1).LT.0) goto 220
          DO 210 ikf=1,5
            kfnow=iabs(kfdp(idc,ikf))
            IF(kfnow.EQ.0) goto 210
            DO 200 icmp=1,ncmp
              IF(kfcmp(icmp).EQ.kfnow) THEN
                mdme(idc,1)=mode-3
                goto 220
              ENDIF
  200      CONTINUE
  210     CONTINUE
  220   CONTINUE
        RETURN
      ENDIF

C...Multiple matchings required.
      DO 260 idc=idcbeg,idcbeg+idclen-1
        IF(mdme(idc,1).LT.0) goto 260
        ntmp=ncmp
        DO 230 itmp=1,ntmp
          kftmp(itmp)=kfcmp(itmp)
  230   CONTINUE  
        nfin=0 
        DO 250 ikf=1,5
          kfnow=iabs(kfdp(idc,ikf))
          IF(kfnow.EQ.0) goto 250
          nfin=nfin+1
          DO 240 itmp=1,ntmp
            IF(kftmp(itmp).EQ.kfnow) THEN
              kftmp(itmp)=kftmp(ntmp) 
              ntmp=ntmp-1
              goto 250
            ENDIF
  240     CONTINUE
  250   CONTINUE
        IF(ntmp.EQ.0.AND.mode.LE.6) mdme(idc,1)=mode-5
        IF(ntmp.EQ.0.AND.nfin.EQ.ncmp.AND.mode.GE.7) 
     &  mdme(idc,1)=mode-7
  260 CONTINUE
      RETURN

C...Error exit for impossible read of particle code.
  300 CALL pyerrm(18,'(PYONOF:) could not interpret particle code '
     &//chcode)

C...Formats for output.
 1000 FORMAT(' Decays for',i8,' set ',a10)
 1100 FORMAT(' Decays for',i8,' set ',a10,' if match',10i8)

      RETURN
      END