+PATCH,$CORR. +DECK,CORR1. Updates version: 3.07/00 to 3.08/00 +REP,*TITLE*,TITLE,1. * CBKFIT 3.08/00 25/04/95 12.08.52 +ADD,$VERSION,V3_08,*. &DECK,V3_08. *CMZU: 3.08/00 25/04/95 12.08.53 by Pal Hidas *-- Author : Pal Hidas 25/04/95 * *::> VERSION 3.08/00 25/04/95 12.08.52 * * case=13, fit of two secondary Kshort vertices, say for the * PI0 KSH KSH, KSH -> PI0 PI0, KSH -> PI0 PI0 channel. * set CFKSKS=.true. (this is introduced in CFCOMS) * The common SQUIDC is also reorganized (this is not a user * common). 6 words added to the leading part of the subbank * (KSUB) of the KRES bank, which contain the coordinates of * the second vertex and also their pulls * +ADD,CFCOMMON,CFCOMMON,0. *CMZU: 3.08/00 21/04/95 11.21.51 by Pal Hidas +REP,CFCOMMON,CFCOMMON,64. PARAMETER (NCMAX=20,NPMAX=25,NRMAX=10,NVMAX=81) +REP,CFCOMMON,CFCOMMON,96. L ,CFCOLL,CFKSKM,CFKSKS +REP,CFCOMMON,CFCOMMON,106. LOGICAL CFCOLL,CFKSKM,CFKSKS +REP,CFCOMMON,CFCOMMON,286-294. C COMMON /SQUIDC/ X,VAR,ERR,VVAR,DPDX,DFDX,F,GF,H,PFIT,DELX, C * X0,VERT,BQRS,DFDVER,DD,FF,BQRS0,KDIRS,DFDY,GH, C * SSS,PULLD,HHH,KSVT,CHVT,CHVMOM,CHVPAR,CHKMOM, C * CFLY,CHCTAU,XM,ETOT,MASS,MRES,CFVENE,CFVMOM, C * NC,NVAR,KTYPE,MISSID,CASE,NRES,MISSI0, C * NPART,MEM,PMEM,RC,ISPE, C * NCH,NSUM,ITER, C * ENCONS COMMON /SQUIDC/ X,VAR,ERR,VVAR,DFDY,DPDX,DFDX,DELX,DD,FF, D F,GF,PFIT,GH,H,X0,VERT,BQRS,DFDVER,BQRS0, D KSVT,CHVT,KDIRS,CHVMOM,CHVPAR,CHKMOM,CFLY, D CHCTAU,SSS,PULLD,HHH,EN4,PPP4, R XM,ETOT,MASS,MRES,CFVENE,CFVMOM, I NC,NVAR,KTYPE,MISSID,CASE,NRES,MISSI0,NPART, I MEM,PMEM,RC,ISPE,NCH,NSUM,ITER, L ENCONS C +REP,CFCOMMON,CFCOMMON,304-307. DOUBLE PRECISION BQRS0(3,NPMAX),KSVT(3,2),CHVT(3),KDIRS DOUBLE PRECISION CHVMOM(3,4),CHVPAR(3,4),CHKMOM(3) DOUBLE PRECISION CFLY,CHCTAU DOUBLE PRECISION SSS(3,3),PULLD(3),HHH(NCMAX,NCMAX) DOUBLE PRECISION EN4(4),PPP4(4) +ADD,CBKFIT,CFNSQD,0. *CMZU: 3.08/00 22/04/95 14.55.20 by Pal Hidas +ADD,CBKFIT,CFNSQD,75. ELSEIF(CASE.EQ.13) THEN NPAR1=NPART-7 NPAR2=NPART +REP,CBKFIT,CFNSQD,177. WRITE(LDBG,'('' CONSTRAINTS :''/(6G13.6))') +REP,CBKFIT,CFNSQD,226. * case=1-3,6-13 +REP,CBKFIT,CFNSQD,411-414. * case=1-3,6-13 *************** +REP,CBKFIT,CFNSQD,558-568. KSVT(1,1)=X(NVAR-2) KSVT(2,1)=X(NVAR-1) KSVT(3,1)=X(NVAR) ELSEIF(CASE.EQ.13) THEN KSVT(1,1)=X(NVAR-5) KSVT(2,1)=X(NVAR-4) KSVT(3,1)=X(NVAR-3) KSVT(1,2)=X(NVAR-2) KSVT(2,2)=X(NVAR-1) KSVT(3,2)=X(NVAR) ENDIF C ENDIF ********** *case=6-13 ********** C-- CALCULATE NEW BQRS IF(CASE.GE.6.AND.CASE.LE.10.OR.CASE.EQ.13) THEN +ADD,CBKFIT,CFNSQD,581. WRITE(LDBG,'(''RECALCULATE BQRS'')') +ADD,CBKFIT,CFKINI,0. *CMZU: 3.08/00 12/04/95 15.06.47 by Pal Hidas +REP,CBKFIT,CFKINI,73-80. C DOUBLE PRECISION U(3),Y(4),A(3,3),R,FFF(3),UN(3),UW(3) DOUBLE PRECISION SUMGF,SUMGD,SMOD,GFUNCT,GDERIV,RO(NPMAX) DOUBLE PRECISION EN(NPMAX),WNEXT,PPP(NPMAX),PMISS(4) C DOUBLE PRECISION FQE(3,4),FFQE(4),EF(4),EFQW(3),WWW,WSC,WCT DOUBLE PRECISION S,C,PSQ,RP,PP,CL,SL,PXY DOUBLE PRECISION EPSZ /0.2D0/ +REP,CBKFIT,CFKINI,86-90. INTEGER NPAR1,NPAR2,ICL C IRC=0 NC=NC+4 IF(CASE.GE.8.AND.CASE.LE.10) NC=NC+3 IF(CASE.EQ.13) NC=NC+6 +REP,CBKFIT,CFKINI,347-350. **************** * case=8,9,10,13 **************** IF(CASE.GE.8.AND.CASE.LE.10.OR.CASE.EQ.13) THEN +DEL,CBKFIT,CFKINI,358-364. +REP,CBKFIT,CFKINI,371-570. ELSEIF(CASE.EQ.13) THEN NPAR1=NPART-7 NPAR2=NPART-4 ENDIF C ICL=1 CALL CFNSEC(ICL,NPAR1,NPAR2,IRC) IF(IRC.LT.0) RETURN C IF(CASE.EQ.13) THEN NPAR1=NPART-3 NPAR2=NPART ICL=2 CALL CFNSEC(ICL,NPAR1,NPAR2,IRC) IF(IRC.LT.0) RETURN ENDIF +REP,CBKFIT,CFKINI,591-593. X(3*NPART+1)=KSVT(1,1) X(3*NPART+2)=KSVT(2,1) X(3*NPART+3)=KSVT(3,1) ENDIF ********* * case=8 ********* IF(CASE.EQ.13) THEN X(3*NPART+1)=KSVT(1,1) X(3*NPART+2)=KSVT(2,1) X(3*NPART+3)=KSVT(3,1) X(3*NPART+4)=KSVT(1,2) X(3*NPART+5)=KSVT(2,2) X(3*NPART+6)=KSVT(3,2) +REP,CBKFIT,CFKINI,625-628. ************* * case = 9-12 ************* C C -- INITIAL VALUES OF MISSING PARTICLES (CASE >= 9) C IF(CASE.GE.9.AND.CASE.LE.12) THEN +REP,CBKFIT,CFKINI,690-692. RO(IG)=DSQRT((BQRS(1,IG)-KSVT(1,1))**2 & +(BQRS(2,IG)-KSVT(2,1))**2 & +(BQRS(3,IG)-KSVT(3,1))**2) +REP,CBKFIT,CFKINI,698-700. PFIT(1,IG)=PPP4(II)*(BQRS(1,IG)-KSVT(1,1))/RO(IG) PFIT(2,IG)=PPP4(II)*(BQRS(2,IG)-KSVT(2,1))/RO(IG) PFIT(3,IG)=PPP4(II)*(BQRS(3,IG)-KSVT(3,1))/RO(IG) +ADD,CBKFIT,CFUPDA,0. *CMZU: 3.08/00 21/04/95 16.03.40 by Pal Hidas +REP,CBKFIT,CFUPDA,59-60. DOUBLE PRECISION PSI(3),TAU(3),PSQ,SGN,XMR2,CL,SL,VERW(3,2) DOUBLE PRECISION RO(NPMAX),TRO(NPMAX),ENE4(4),KMOM(3) +REP,CBKFIT,CFUPDA,69. INTEGER NVAR1,ICC,JUMP,IP,NPAR2,IRET,IVERK,NPARA,NPARB,NVERK,IVC INTEGER NVARA,NVARB,NVARC +ADD,CBKFIT,CFUPDA,78. CALL DLRMEM(VERW,6) CALL DLRMEM(DPDU,4*NPMAX) +REP,CBKFIT,CFUPDA,86-93. VERW(I,1)=VERT(I) ELSEIF(CASE.GE.8.AND.CASE.LE.10) THEN VERW(I,1)=KSVT(I,1) ELSEIF(CASE.EQ.13) THEN VERW(I,1)=KSVT(I,1) VERW(I,2)=KSVT(I,2) ENDIF 10 CONTINUE C IF(CFDBUG) THEN WRITE(LDBG,'('' VERW(1) :'',3G14.6)') (VERW(III,1),III=1,3) IF(CASE.EQ.13) THEN WRITE(LDBG,'('' VERW(2) :'',3G14.6)') (VERW(III,2),III=1,3) ENDIF +REP,CBKFIT,CFUPDA,104. * case = 1-3,6-13 +REP,CBKFIT,CFUPDA,144. & .OR.CASE.EQ.11.OR.CASE.EQ.12 & .OR.CASE.EQ.13.AND.(NPART-IG).GE.8) THEN +REP,CBKFIT,CFUPDA,185. & .OR.CASE.EQ.11.OR.CASE.EQ.12 & .OR.CASE.EQ.13.AND.(NPART-IG).GE.8) THEN +REP,CBKFIT,CFUPDA,232-237. RO(IG)=DSQRT((BQRS(1,IG)-VERW(1,1))**2 & +(BQRS(2,IG)-VERW(2,1))**2 & +(BQRS(3,IG)-VERW(3,1))**2) TRO(IG)=DSQRT(BQRS(1,IG)**2+BQRS(2,IG)**2+BQRS(3,IG)**2) RRR=(RO(IG)/TRO(IG))**3 ST=SIN(X(3*IG-1)) VT=VERW(3,1)/TRO(IG) +REP,CBKFIT,CFUPDA,251-253. PFIT(1,IG)=PPP(IG)*(BQRS(1,IG)-VERW(1,1))/RO(IG) PFIT(2,IG)=PPP(IG)*(BQRS(2,IG)-VERW(2,1))/RO(IG) PFIT(3,IG)=PPP(IG)*(BQRS(3,IG)-VERW(3,1))/RO(IG) +REP,CBKFIT,CFUPDA,269-276. **************** * case = 7-10,13 **************** ELSEIF(CASE.EQ.7.OR.CASE.EQ.8.AND.(NPART-IG).LT.4.OR. & (CASE.EQ.9.OR.CASE.EQ.10).AND. & (NPART-IG).LE.5.AND.NPART.NE.IG & .OR.CASE.EQ.13.AND.(NPART-IG).LT.8) THEN C IF(CASE.EQ.13.AND.(NPART-IG).LT.4) THEN IVERK=2 ELSE IVERK=1 ENDIF C RO(IG)=DSQRT((BQRS(1,IG)-VERW(1,IVERK))**2 & +(BQRS(2,IG)-VERW(2,IVERK))**2 & +(BQRS(3,IG)-VERW(3,IVERK))**2) +REP,CBKFIT,CFUPDA,282-284. PFIT(1,IG)=PPP(IG)*(BQRS(1,IG)-VERW(1,IVERK))/RO(IG) PFIT(2,IG)=PPP(IG)*(BQRS(2,IG)-VERW(2,IVERK))/RO(IG) PFIT(3,IG)=PPP(IG)*(BQRS(3,IG)-VERW(3,IVERK))/RO(IG) +REP,CBKFIT,CFUPDA,292-294. Y1=CL*C-VERW(1,IVERK)/TRO(IG) Y2=CL*S-VERW(2,IVERK)/TRO(IG) Y3=SL-VERW(3,IVERK)/TRO(IG) +ADD,CBKFIT,CFUPDA,307. C IF(CFDBUG) THEN WRITE(LDBG,'(''IG,IVERK,TRO(IG) :'',2I3,G12.4)') & IG,IVERK,TRO(IG) WRITE(LDBG,'(''Y,Y1,Y2,Y3 :'',4G12.4)') Y,Y1,Y2,Y3 WRITE(LDBG,'(''DPDU(*,IG) :'',4G12.4)') (DPDU(III,IG),III=1,4) ENDIF C +REP,CBKFIT,CFUPDA,351-352. RO(IG)=DSQRT((BQRS(1,IG)-VERW(1,1))**2 & +(BQRS(2,IG)-VERW(2,1))**2 & +(BQRS(3,IG)-VERW(3,1))**2) +REP,CBKFIT,CFUPDA,367-369. PFIT(1,IG)=PPP(IG)*(BQRS(1,IG)-VERW(1,1))/RO(IG) PFIT(2,IG)=PPP(IG)*(BQRS(2,IG)-VERW(2,1))/RO(IG) PFIT(3,IG)=PPP(IG)*(BQRS(3,IG)-VERW(3,1))/RO(IG) +REP,CBKFIT,CFUPDA,478. IF(CASE.EQ.3) GOTO 670 +ADD,CBKFIT,CFUPDA,488. ELSEIF(CASE.EQ.13) THEN NVAR6=NVAR-6 +ADD,CBKFIT,CFUPDA,495. ELSEIF(CASE.EQ.13) THEN NPAR1=NPART-7 NPAR2=NPART +REP,CBKFIT,CFUPDA,513-549. IF(CASE.GE.6.AND.CASE.LE.10.OR.CASE.EQ.13) THEN C DO 352 IG=NPAR1,NPAR2 C IF(CASE.EQ.13.AND.(NPAR2-IG).LT.4) THEN IVERK=2 ELSE IVERK=1 ENDIF C IF(CASE.EQ.13.AND.IVERK.EQ.1) THEN NVARC=NVAR-3 ELSE NVARC=NVAR ENDIF C EN(IG)=X(3*IG)**2 PPP(IG)=EN(IG) IF(MASS(IG).GE.1.E-4) PPP(IG)=DSQRT(EN(IG)**2-MASS(IG)**2) RO(IG)=DSQRT((BQRS(1,IG)-VERW(1,IVERK))**2 & +(BQRS(2,IG)-VERW(2,IVERK))**2 & +(BQRS(3,IG)-VERW(3,IVERK))**2) C IF(CASE.EQ.6) THEN C DFDX(NVARC,1)=DFDX(NVARC,1)+(PFIT(1,IG)*PFIT(3,IG)) & /(PPP(IG)*RO(IG)) DFDX(NVARC,2)=DFDX(NVARC,2)+(PFIT(2,IG)*PFIT(3,IG)) & /(PPP(IG)*RO(IG)) DFDX(NVARC,3)=DFDX(NVARC,3)-(PFIT(1,IG)**2+PFIT(2,IG)**2) & /(PPP(IG)*RO(IG)) C ELSEIF(CASE.GE.7) THEN C DFDX(NVARC-2,3)=DFDX(NVARC-2,3)+(PFIT(1,IG)*PFIT(3,IG)) & /(PPP(IG)*RO(IG)) DFDX(NVARC-2,2)=DFDX(NVARC-2,2)+(PFIT(2,IG)*PFIT(1,IG)) & /(PPP(IG)*RO(IG)) DFDX(NVARC-1,1)=DFDX(NVARC-1,1)+(PFIT(1,IG)*PFIT(2,IG)) & /(PPP(IG)*RO(IG)) DFDX(NVARC-1,3)=DFDX(NVARC-1,3)+(PFIT(2,IG)*PFIT(3,IG)) & /(PPP(IG)*RO(IG)) DFDX(NVARC,1)=DFDX(NVARC,1)+(PFIT(1,IG)*PFIT(3,IG)) & /(PPP(IG)*RO(IG)) DFDX(NVARC,2)=DFDX(NVARC,2)+(PFIT(2,IG)*PFIT(3,IG)) & /(PPP(IG)*RO(IG)) DFDX(NVARC-2,1)=DFDX(NVARC-2,1)-(PFIT(3,IG)**2+PFIT(2,IG)**2) & /(PPP(IG)*RO(IG)) DFDX(NVARC-1,2)=DFDX(NVARC-1,2)-(PFIT(1,IG)**2+PFIT(3,IG)**2) & /(PPP(IG)*RO(IG)) DFDX(NVARC,3)=DFDX(NVARC,3)-(PFIT(1,IG)**2+PFIT(2,IG)**2) +REP,CBKFIT,CFUPDA,558-559. ELSEIF(CASE.GE.7.AND.CASE.LE.10) THEN NVAR1=NVAR-2 ELSEIF(CASE.EQ.13) THEN NVAR1=NVAR-5 +REP,CBKFIT,CFUPDA,566-573. ****************** * case = 8,9,10,13 ****************** C C...KSHORT MOMENTUM CONSTRAINTS DERIVATIVES C IF(CASE.GE.8.AND.CASE.LE.10.OR.CASE.EQ.13) THEN C IF(CASE.EQ.13) THEN NVERK=2 ELSE NVERK=1 ENDIF C DO 370 IVERK=1,NVERK IVC=(NVERK-IVERK+1)*3 NVARA=NVAR-IVC NVARB=NVARA+2 C IF(CFDBUG) WRITE(LDBG,'(''NVERK,IVERK :'',2I3)') NVERK,IVERK C IF(CASE.EQ.13.AND.IVERK.EQ.1) THEN NPARA=NPAR1 NPARB=NPAR1+3 ELSEIF(CASE.EQ.13.AND.IVERK.EQ.2) THEN NPARA=NPAR2-3 NPARB=NPAR2 ELSE NPARA=NPAR1 NPARB=NPAR2 ENDIF C RV=DSQRT(VERW(1,IVERK)**2+VERW(2,IVERK)**2+VERW(3,IVERK)**2) +REP,CBKFIT,CFUPDA,583-586. DO 361 J=NPARA,NPARB JJJ=J-NPARB+4 ENE4(JJJ)=X(3*J)**2 EK=EK+ENE4(JJJ) +REP,CBKFIT,CFUPDA,607. KMOM(INC)=PK*VERW(INC,IVERK)/RV +REP,CBKFIT,CFUPDA,616-630. DO 365 J=NPARA,NPARB DFDX(3*J,NC-IVC+INC)=DFDX(3*J,NC-IVC+INC)+ & 2*X(3*J)*EK/PK*X(NVAR-IVC+INC)/RV DO 365 I=1,3 IVAR=3*(J-1)+I DFDX(IVAR,NC-IVC+INC)=DFDX(IVAR,NC-IVC+INC)-DFDX(IVAR,INC) 365 CONTINUE C...VERTEX PARAMETER DERIVATIVES IF(CFDBUG) WRITE(LDBG,'('' VERTEX DERIVATIVES'')') DO 367 INC=1,3 JVAR=NVAR-IVC+INC DFDX(JVAR,NC-IVC+INC)=DFDX(JVAR,NC-IVC+INC)+PK/RV DO 367 IVAR=NVARA,NVARB DFDX(IVAR,NC-IVC+INC)=DFDX(IVAR,NC-IVC+INC)-DFDX(IVAR,INC) DFDX(IVAR,NC-IVC+INC)=DFDX(IVAR,NC-IVC+INC)- +REP,CBKFIT,CFUPDA,637-642. IC=NC-IVC+INC F(IC)=PK*VERW(INC,IVERK)/RV DO 369 IG=NPARA,NPARB F(IC)=F(IC)-PFIT(INC,IG) 369 CONTINUE C 370 CONTINUE +REP,CBKFIT,CFUPDA,705. C IF(CASE.EQ.6.OR.CASE.EQ.7 & .OR.CASE.GE.8.AND.CASE.LE.10.AND.JRES.GE.NRES-2 & .OR.CASE.EQ.13.AND.JRES.GE.NRES-5) THEN C +REP,CBKFIT,CFUPDA,869. 670 CONTINUE +REP,CBKFIT,CFUPDA,1158. ELSEIF(CASE.GE.7.AND.CASE.LE.10.OR.CASE.EQ.13) THEN +ADD,CBKFIT,CFUPDA,1163. IF(CASE.EQ.13) THEN DO 1021 I=1,3 CW(NVAR-6+I,NVAR-6+I)=CFVTER(I) 1021 CONTINUE ENDIF C +ADD,CBKFIT,CFNSEC,*. &DECK,cfnsec. *CMZU: 3.08/00 20/04/95 14.34.48 by Pal Hidas *-- Author : Pal Hidas 10/04/95 SUBROUTINE CFNSEC(ICL,NPAR1,NPAR2,IRC) * * Author: Pal Hidas * * Creation date: 10 April, 1995 * * References: * * Description: * * Subroutines referenced: * * &SELF,IF=-F77,IF=-SUN. IMPLICIT NONE &SELF,IF=-F77,IF=SUN. IMPLICIT UNDEFINED (A-Z) &SELF. &SEQ,CBUNIT. &SEQ,CFPARA. &SEQ,CFVARS. &SEQ,SQUIDC. &SEQ,CFSTER. &SEQ,CFCOMB. &SEQ,CBLINK. DOUBLE PRECISION U(3),Y(4),A(3,3),R,FFF(3),UN(3),UW(3) DOUBLE PRECISION EK,PK(3),PPK,MK,PP4(3,4) DOUBLE PRECISION FQE(3,4),WWW,WSC,WCT C DOUBLE PRECISION S,C,PSQ,RP,PP,CL,SL,PXY DOUBLE PRECISION EPSK /0.05D0/ DOUBLE PRECISION ZINCMX /70.D0/ REAL RMK LOGICAL RES INTEGER M,N,IG,K,IC,I,II,ITYP,ICHAR,JJ INTEGER J,L,IIP1,III,INMAX,ICP1,ICP2,IRC,JUMP,IW(3),IFAIL INTEGER NPAR1,NPAR2,ICL C C-- NEWTON ITERATION FOR SECONDARY VERTEX FIT C IF(CFDBUG) THEN WRITE(LDBG,'('' ICL='',I2)') ICL ENDIF C INMAX=0 EK=0.D0 DO 350 I=1,3 PK(I)=0.D0 U(I)=0.D0 350 CONTINUE C C...GAMMA AND KSHORT 4-MOMENTA C DO 360 J=NPAR1,NPAR2 JJ=J-NPAR2+4 EN4(JJ)=X(3*J)**2 EK=EK+EN4(JJ) PPP4(JJ)=EN4(JJ) PP4(1,JJ)=PPP4(JJ)*COS(X(3*J-1))*COS(X(3*J-2)) PP4(2,JJ)=PPP4(JJ)*COS(X(3*J-1))*SIN(X(3*J-2)) PP4(3,JJ)=PPP4(JJ)*SIN(X(3*J-1)) DO 360 I=1,3 PK(I)=PK(I)+PP4(I,JJ) 360 CONTINUE C IF(CFDBUG) THEN WRITE(LDBG,'(''EN4 :''/4G13.5)') (EN4(I),I=1,4) WRITE(LDBG,'(''PP4 :''/(4G13.5))') & ((PP4(I,J),J=1,4),I=1,3) ENDIF C CALL CFLKUP('KSH ',ITYP,RMK,ICHAR,RES) MK=RMK C IF(EK.GT.MK) THEN PPK=DSQRT(EK**2-MK**2) ELSE IRC=-2 IF(CFDBUG) THEN WRITE(LDBG,'(''DROPPED BY CFKINI, IRC=-2'')') ENDIF IF(CFTRHY) THEN WRITE(LLOG,'(''DROPPED BY CFKINI, IRC=-2'')') ENDIF RETURN ENDIF C DO 370 I=1,3 U(I)=PK(I)/PPK*0.1D0 370 CONTINUE C IF(CFDBUG) THEN WRITE(LDBG,'('' MK,EK,PPK :'',3G13.5)') MK,EK,PPK WRITE(LDBG,'('' PK0(1,2,3):'',3G13.5)') (PK(II),II=1,3) ENDIF C C...ITERATION C 400 CONTINUE INMAX=INMAX+1 C R=DSQRT(U(1)**2+U(2)**2+U(3)**2) DO 401 I=1,3 PK(I)=PPK*U(I)/R 401 CONTINUE C IF(CFDBUG) THEN WRITE(LDBG,'(''INMAX='',I4)') INMAX WRITE(LDBG,'(''U,R : '',4G13.5)') (U(I),I=1,3),R ENDIF C DO 403 J=1,4 Y(J)=0.D0 DO 402 I=1,3 FQE(I,J)=BQRS(I,NPAR2-4+J)-U(I) Y(J)=Y(J)+(FQE(I,J))**2 402 CONTINUE Y(J)=DSQRT(Y(J)) 403 CONTINUE C IF(CFDBUG) THEN WRITE(LDBG,'('' PK :'',3G13.5)') (PK(I),I=1,3) WRITE(LDBG,'('' Y :'',4G13.5)') (Y(I),I=1,4) WRITE(LDBG,'('' FQE :''/(6G13.5))') & ((FQE(II,JJ),II=1,3),JJ=1,4) ENDIF C C...CONSTRAINT DO 430 I=1,3 FFF(I)=PPK*U(I)/R DO 430 J=1,4 FFF(I)=FFF(I)-EN4(J)*FQE(I,J)/Y(J) 430 CONTINUE C IF(CFDBUG) THEN WRITE(LDBG,'(''FFF :'',3G13.5)') (FFF(II),II=1,3) ENDIF C...AND ITS DERIVATIVE DO 440 K=1,3 DO 440 I=1,3 A(I,K)=-PPK*U(I)*U(K)/R**3 IF(I.EQ.K) A(I,K)=A(I,K)+PPK/R DO 440 J=1,4 IF(I.EQ.K) A(I,K)=A(I,K)+EN4(J)/Y(J) A(I,K)=A(I,K)-EN4(J)/Y(J)**3*FQE(I,J)*FQE(K,J) 440 CONTINUE C IF(CFDBUG) THEN WRITE(LDBG,'('' A :''/(3G13.5))') ((A(I,K),K=1,3),I=1,3) ENDIF C...INVERSION C CALL DINV(3,A,3,IW,IFAIL) C IF(CFDBUG) THEN WRITE(LDBG,'('' IFAIL :'',I5)') IFAIL WRITE(LDBG,'('' A :''/(3G13.5))') ((A(I,K),K=1,3),I=1,3) ENDIF C IF(IFAIL.NE.0) THEN IRC=-3 IF(CFDBUG) THEN WRITE(LDBG,'(''DROPPED BY CFKINI, IRC=-3'')') ENDIF IF(CFTRHY) THEN WRITE(LLOG,'(''DROPPED BY CFKINI, IRC=-3'')') ENDIF RETURN ENDIF C CALL DMMPY(3,3,A(1,1),A(1,2),A(2,1),FFF(1),FFF(2),UW(1),UW(2)) C DO 445 I=1,3 UN(I)=U(I)-UW(I) 445 CONTINUE C IF(CFDBUG) THEN WRITE(LDBG,'(''UW :'',3G13.5)') (UW(II),II=1,3) WRITE(LDBG,'(''UN :'',3G13.5)') (UN(II),II=1,3) ENDIF C WWW=0.D0 WSC=0.D0 WCT=0.D0 DO 450 I=1,3 WCT=WCT+(UN(I))**2 WWW=WWW+(U(I)-UN(I))**2 WSC=WSC+U(I)*UN(I) 450 CONTINUE WWW=DSQRT(WWW) WCT=DSQRT(WCT) C IF(CFDBUG) THEN WRITE(LDBG,'(''WCT,WSC,WWW :'',3G15.8)') WCT,WSC,WWW ENDIF C C...CHECK FOR CONVERGENCE C IF (WWW.LT.EPSK) THEN C IF(WSC.LE.0.D0) THEN IRC=-4 IF(CFDBUG) THEN WRITE(LDBG,'('' UNSUCCESFUL NEWTON ITERATION (KSH),WSC='' & ,G13.5)') WSC ENDIF IF(CFTRHY) THEN WRITE(LLOG,'('' UNSUCCESFUL NEWTON ITERATION (KSH),WSC='' & ,G13.5)') WSC ENDIF RETURN ELSE IF(CFDBUG) THEN WRITE(LDBG,'('' SUCCESFUL NEWTON ITERATION (KSH),WCT='' & ,G13.5)') WCT ENDIF IF(CFTRHY) THEN WRITE(LLOG,'('' SUCCESFUL NEWTON IT.(KSH),VERTEX :'' & ,3G13.5)') (UN(I),I=1,3) ENDIF GOTO 500 ENDIF ENDIF C IF(WWW.GT.ZINCMX.OR.INMAX.GT.50) THEN C IF(CFTRHY) THEN WRITE(LLOG,'('' *** WARNING *** NEWTON ITERATION '''// & ',''FAILED FOR CASE ='',I2)') CASE ENDIF IF(CFDBUG) THEN WRITE(LDBG,'('' NEWTON ITERATION FAILED,CASE='',I2)') & CASE ENDIF C IRC=-5 RETURN ELSE DO 480 I=1,3 U(I)=UN(I) 480 CONTINUE GOTO 400 ENDIF C 500 CONTINUE C DO 510 I=1,3 KSVT(I,ICL)=UN(I) 510 CONTINUE C RETURN END +ADD,CBHYPO,CFDOHY,0. *CMZU: 3.08/00 23/04/95 14.48.25 by Pal Hidas +REP,CBHYPO,CFDOHY,88. INTEGER IHA,IHB,NUMWAR,IC +REP,CBHYPO,CFDOHY,191-193. IF(CFSUPC) THEN DO IC=1,NPART NXTCMB(IC)=IC ENDDO +ADD,CBHYPO,CFDOHY,203. WRITE(LDBG,'('' CALLCO,NXTCMB :'',I3,3X,20I2)') & CALLCO,(NXTCMB(II),II=1,NPART) +ADD,CBHYPO,CFDOHY,440. ELSEIF(CASE.EQ.13) THEN GODNES=PROB(CHISQ,NC-6) +REP,CBHYPO,CFDOHY,523. WRITE(LLOG,'('' VERTEX :'',3G14.6)') (KSVT(III,1),III=1,3) ELSEIF(CASE.EQ.13) THEN WRITE(LLOG,'('' VERTEX :'',3G14.6)') (KSVT(III,1),III=1,3) WRITE(LLOG,'('' VERTEX :'',3G14.6)') (KSVT(III,2),III=1,3) +REP,CBHYPO,CFDOHY,537. WRITE(LLOG,'(''R/EV:'',I5,I6,I3,''C,CA:'',I2, +ADD,CBHYPO,CFINIT,0. *CMZU: 3.08/00 19/04/95 16.04.55 by Pal Hidas +REP,CBHYPO,CFINIT,117-118. CFKSKS=.FALSE. C IF(CFKS00.OR.CFKSKS) THEN +ADD,CBHYPO,CFSELE,0. *CMZU: 3.08/00 19/04/95 16.09.23 by Pal Hidas +ADD,CBHYPO,CFSELE,186. IF(CFKSKS.AND.CFVERT.OR.CFKSKS.AND.CFVERA) THEN WRITE(LERR,'('' *** ERROR *** BOTH KSHORT AND FULL VERTEX FIT HAS & BEEN REQUESTED'')') ENDIF C +ADD,CBHYPO,CFSELE,191. IF(CFKSKS.AND.CFVRTZ.OR.CFKSKS.AND.CFVERZ) THEN WRITE(LERR,'('' *** ERROR *** BOTH KSHORT AND Z-VERTEX FIT HAS & BEEN REQUESTED'')') ENDIF C +ADD,CBHYPO,CFSELE,263. IF(CFKSKS) THEN C CASE=13 C NVAR=3*NPART+6 C IF(MISGAM) THEN WRITE(LERR,'('' *** ERROR *** KSHORT FIT WITH MISSING GAMMA'')') ENDIF IF(MISSKL) THEN WRITE(LERR,'('' *** ERROR *** KSHORT FIT WITH MISSING KLONG'')') ENDIF IF(MISNEU) THEN WRITE(LERR,'('' *** ERROR *** KSHORT FIT WITH MISSING NEUTRON &'')') ENDIF IF(CFMISM.NE.0.) THEN WRITE(LERR,'('' *** ERROR *** KSHORT FIT WITH MISSING PARTICLE & X'')') ENDIF IF(MISPRO) THEN WRITE(LERR,'('' *** ERROR *** KSHORT FIT WITH MISSING PROTON &'')') ENDIF IF(BADNEU.NE.0.OR.BADTRA.NE.0.OR.BADKL.NE.0) THEN WRITE(LERR,'('' *** ERROR *** KSHORT FIT WITH MISSING ENERGY &'')') ENDIF ENDIF C +ADD,CBHYPO,CFREA,0. *CMZU: 3.08/00 22/04/95 11.35.20 by Pal Hidas +ADD,CBHYPO,CFREA,277. IF(CFDBUG) THEN WRITE(LDBG,'(''BQRS0 FILLED :''/(3G12.4))') & ((BQRS0(J,I),J=1,3),I=1,NSUM) ENDIF C +ADD,CBHYPO,CFZOUT,0. *CMZU: 3.08/00 19/04/95 16.21.55 by Pal Hidas +REP,CBHYPO,CFZOUT,75. DATA NWSUBF /15/ +REP,CBHYPO,CFZOUT,166-169. ELSEIF(CFKSKS) THEN Q(LKSUB+3)=X(NVAR-5) Q(LKSUB+4)=X(NVAR-1) Q(LKSUB+5)=X(NVAR-3) Q(LKSUB+6)=PULL(NVAR-5) Q(LKSUB+7)=PULL(NVAR-4) Q(LKSUB+8)=PULL(NVAR-3) Q(LKSUB+9)=X(NVAR-2) Q(LKSUB+10)=X(NVAR-1) Q(LKSUB+11)=X(NVAR) Q(LKSUB+12)=PULL(NVAR-2) Q(LKSUB+13)=PULL(NVAR-1) Q(LKSUB+14)=PULL(NVAR) ENDIF C IFP=NWSUBF IQ(LKSUB+15)=NPART+NRES