pythiaeRHIC/pythia/pyldcm.f

0001
0002 C*********************************************************************
0003
0004 C...PYLDCM
0005 C...Auxiliary to PYSIGH, for technicolor corrections to QCD 2 -> 2
0006 C...processes.
0007
0008       SUBROUTINE PYLDCM(A,N,NP,INDX,D)
0009       IMPLICIT NONE
0010       INTEGER N,NP,INDX(N)
0011       REAL*8 D,TINY
0012       COMPLEX*16 A(NP,NP)
0013       PARAMETER (TINY=1.0D-20)
0014       INTEGER I,IMAX,J,K
0015       REAL*8 AAMAX,VV(6),DUM
0016       COMPLEX*16 SUM,DUMC
0017
0018       D=1D0
0019       DO 110 I=1,N
0020         AAMAX=0D0
0021         DO 100 J=1,N
0022           IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J))
0023   100   CONTINUE
0024         IF (AAMAX.EQ.0D0) CALL PYERRM(28,'(PYLDCM:) singular matrix')
0025         VV(I)=1D0/AAMAX
0026   110 CONTINUE
0027       DO 180 J=1,N
0028         DO 130 I=1,J-1
0029           SUM=A(I,J)
0030           DO 120 K=1,I-1
0031             SUM=SUM-A(I,K)*A(K,J)
0032   120     CONTINUE
0033           A(I,J)=SUM
0034   130   CONTINUE
0035         AAMAX=0D0
0036         DO 150 I=J,N
0037           SUM=A(I,J)
0038           DO 140 K=1,J-1
0039             SUM=SUM-A(I,K)*A(K,J)
0040   140     CONTINUE
0041           A(I,J)=SUM
0042           DUM=VV(I)*ABS(SUM)
0043           IF (DUM.GE.AAMAX) THEN
0044             IMAX=I
0045             AAMAX=DUM
0046           ENDIF
0047   150   CONTINUE
0048         IF (J.NE.IMAX)THEN
0049           DO 160 K=1,N
0050             DUMC=A(IMAX,K)
0051             A(IMAX,K)=A(J,K)
0052             A(J,K)=DUMC
0053   160     CONTINUE
0054           D=-D
0055           VV(IMAX)=VV(J)
0056         ENDIF
0057         INDX(J)=IMAX
0058         IF(ABS(A(J,J)).EQ.0D0) A(J,J)=DCMPLX(TINY,0D0)
0059         IF(J.NE.N)THEN
0060           DO 170 I=J+1,N
0061             A(I,J)=A(I,J)/A(J,J)
0062   170     CONTINUE
0063         ENDIF
0064   180 CONTINUE
0065
0066       RETURN
0067       END