← Back to branch summary

~maddevelopers/mg5amcnlo/2.9.4

« back to all changes in this revision

Viewing changes to Template/loop_material/Checks/StabilityCheckDriver.f

pass to v2.0.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
Template/loop_material/Checks/StabilityCheckDriver.f
 
1
      PROGRAM DRIVER
 
2
!**************************************************************************
 
3
!     THIS IS THE DRIVER FOR CHECKING THE STABILITY OF THE LOOP MATRIX
 
4
!     ELEMENTS
 
5
!**************************************************************************
 
6
      IMPLICIT NONE
 
7
!     
 
8
!     CONSTANTS  
 
9
!     
 
10
      REAL*8 ZERO
 
11
      PARAMETER (ZERO=0D0)
 
12
 
 
13
!     
 
14
!     INCLUDE FILES
 
15
!     
 
16
!---  the include file with the values of the parameters and masses      
 
17
      INCLUDE "coupl.inc"
 
18
!---  integer nexternal ! number particles (incoming+outgoing) in the me 
 
19
      INCLUDE "nexternal.inc" 
 
20
      INCLUDE "MadLoopParams.inc"
 
21
 
 
22
!     
 
23
!     LOCAL
 
24
!     
 
25
      INTEGER I,J,K
 
26
      REAL*8 P(0:3,NEXTERNAL)   ! four momenta. Energy is the zeroth component.
 
27
      REAL*8 SQRTS,MATELEM(3),BORNELEM,AO2PI           ! sqrt(s)= center of mass energy 
 
28
      REAL*8 PIN(0:3), POUT(0:3)
 
29
      CHARACTER*120 BUFF(NEXTERNAL)
 
30
      CHARACTER*1 EX 
 
31
      INTEGER HELCHOICE
 
32
 
 
33
!     
 
34
!     EXTERNAL
 
35
!     
 
36
      REAL*8 DOT
 
37
      EXTERNAL DOT
 
38
 
 
39
!-----
 
40
!     BEGIN CODE
 
41
!-----
 
42
!     
 
43
!---  INITIALIZATION CALLS
 
44
!     
 
45
!---  Call to initialize the values of the couplings, masses and widths 
 
46
!     used in the evaluation of the matrix element. The primary parameters of the
 
47
!     models are read from Cards/param_card.dat. The secondary parameters are calculated
 
48
!     in Source/MODEL/couplings.f. The values are stored in common blocks that are listed
 
49
!     in coupl.inc .
 
50
 
 
51
      call setpara('param_card.dat')  !first call to setup the paramaters
 
52
 
 
53
      AO2PI=G**2/(8.D0*(3.14159265358979323846d0**2))
 
54
 
 
55
 
 
56
      call printout()
 
57
 
 
58
      do while (.TRUE.)
 
59
        write(*,*) "Exit? ['y','n']"
 
60
        read(*,*) EX
 
61
        if (EX.eq.'y'.or.EX.eq.'Y') THEN
 
62
          exit
 
63
        endif
 
64
        write(*,*) "Enter CTModeRun"
 
65
        read(*,*) CTMODERUN
 
66
        write(*,*) "PS pt, parts. as in proc and format (E,p_x,p_y,p_z)"
 
67
        do i=1,NExternal
 
68
          read(*,*) P(0,i),P(1,i),P(2,i),P(3,i)
 
69
        enddo
 
70
        do i=0,3
 
71
          PIN(i)=0.0d0
 
72
          do j=1,nincoming
 
73
            PIN(i)=PIN(i)+p(i,j)
 
74
          enddo
 
75
        enddo
 
76
        SQRTS=dsqrt(dabs(DOT(PIN(0),PIN(0))))
 
77
        write(*,*) "Enter MU_R, -1.0d0 = default"
 
78
        read(*,*) MU_R
 
79
        if (MU_R.lt.0.0d0) then
 
80
          MU_R=SQRTS            
 
81
        endif
 
82
        write(*,*) "Enter Helicity tag, -1 = summed. For loops only."
 
83
        read(*,*) HELCHOICE
 
84
!---  Update the couplings with the new MU_R
 
85
        CALL UPDATE_AS_PARAM()
 
86
!     
 
87
!     Now we can call the matrix element!
 
88
!
 
89
        CALL SMATRIX(P,BORNELEM) 
 
90
        IF (HELCHOICE.EQ.-1) THEN
 
91
          CALL SLOOPMATRIX(P,MATELEM)
 
92
        ELSE
 
93
          CALL SLOOPMATRIXHEL(P,HELCHOICE,MATELEM)
 
94
        ENDIF
 
95
        write(*,*) '##TAG#RESULT_START#TAG##'
 
96
        do i=1,nexternal      
 
97
          write (*,'(a2,1x,5e25.15)') 'PS',P(0,i),P(1,i),P(2,i),P(3,i)
 
98
        enddo
 
99
        write (*,'(a3,1x,i2)') 'EXP',-(2*nexternal-8)
 
100
        write (*,'(a4,1x,1e25.15)') 'BORN',BORNELEM
 
101
        write (*,'(a3,1x,1e25.15)') 'FIN',MATELEM(1)/BORNELEM/AO2PI
 
102
        write (*,'(a4,1x,1e25.15)') '1EPS',MATELEM(2)/BORNELEM/AO2PI
 
103
        write (*,'(a4,1x,1e25.15)') '2EPS',MATELEM(3)/BORNELEM/AO2PI
 
104
        write (*,*) 'Export_Format Default'
 
105
        write(*,*) '##TAG#RESULT_STOP#TAG##'      
 
106
      enddo
 
107
 
 
108
      end
 
109
      
 
110
        
 
111
        
 
112
        
 
113
         double precision function dot(p1,p2)
 
114
C****************************************************************************
 
115
C     4-Vector Dot product
 
116
C****************************************************************************
 
117
      implicit none
 
118
      double precision p1(0:3),p2(0:3)
 
119
      dot=p1(0)*p2(0)-p1(1)*p2(1)-p1(2)*p2(2)-p1(3)*p2(3)
 
120
      end