~maddevelopers/mg5amcnlo/2.7.1.3

« back to all changes in this revision

Viewing changes to tests/input_files/IOTestsComparison/long_ML_SMQCD_default/gg_wmtbx/improve_ps.f

  • Committer: olivier Mattelaer
  • Date: 2016-05-12 11:00:18 UTC
  • mfrom: (262.1.150 2.3.4)
  • Revision ID: olivier.mattelaer@uclouvain.be-20160512110018-sevb79f0wm4g8mpp
pass to 2.4.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
106
106
      ENDIF
107
107
      IF (ERRCODE.NE.0) THEN
108
108
        IF (WARNED.LT.20) THEN
109
 
          WRITE(*,*) 'INFO:: Attempting to rescue the precisio'
110
 
     $     //'n improvement with an alternative method.'
 
109
          WRITE(*,*) 'INFO:: Attempting to rescue the precision'
 
110
     $     //' improvement with an alternative method.'
111
111
          WARNED=WARNED+1
112
112
        ENDIF
113
113
        IF (IMPROVEPSPOINT.EQ.1) THEN
114
 
          CALL ML5_0_MP_ORIG_IMPROVE_PS_POINT_PRECISION(NEWP,ERRCODETMP
115
 
     $     ,WARNED)
 
114
          CALL ML5_0_MP_ORIG_IMPROVE_PS_POINT_PRECISION(NEWP
 
115
     $     ,ERRCODETMP,WARNED)
116
116
        ELSEIF((IMPROVEPSPOINT.EQ.2).OR.(IMPROVEPSPOINT.LE.0)) THEN
117
 
          CALL ML5_0_MP_PSMC_IMPROVE_PS_POINT_PRECISION(NEWP,ERRCODETMP
118
 
     $     ,WARNED)
 
117
          CALL ML5_0_MP_PSMC_IMPROVE_PS_POINT_PRECISION(NEWP
 
118
     $     ,ERRCODETMP,WARNED)
119
119
        ENDIF
120
120
        IF (ERRCODETMP.NE.0) GOTO 100
121
121
      ENDIF
125
125
      GOTO 101
126
126
 100  CONTINUE
127
127
      IF (WARNED.LT.20) THEN
128
 
        WRITE(*,*) 'WARNING:: This PS point could not be improved'
129
 
     $   //'. Error code = ',ERRCODE,ERRCODETMP
 
128
        WRITE(*,*) 'WARNING:: This PS point could not be improved.'
 
129
     $   //' Error code = ',ERRCODE,ERRCODETMP
130
130
        CALL ML5_0_MP_WRITE_MOM(P)
131
131
        WARNED = WARNED +1
132
132
      ENDIF
140
140
 102  CONTINUE
141
141
 
142
142
      IF (WARNED.GE.20.AND..NOT.TOLD_SUPPRESS) THEN
143
 
        WRITE(*,*) 'INFO:: Further warnings from the improve_p'
144
 
     $   //'s routine will now be supressed.'
 
143
        WRITE(*,*) 'INFO:: Further warnings from the improve_ps'
 
144
     $   //' routine will now be supressed.'
145
145
        TOLD_SUPPRESS=.TRUE.
146
146
      ENDIF
147
147
 
188
188
        ML5_0_MP_IS_CLOSE = .FALSE.
189
189
        IF (WARNED.LT.20) THEN
190
190
          BUFFDP = (REF/REF2)
191
 
          WRITE(*,*) 'WARNING:: The improved PS point is too far fro'
192
 
     $     //'m the original one',BUFFDP
 
191
          WRITE(*,*) 'WARNING:: The improved PS point is too far from'
 
192
     $     //' the original one',BUFFDP
193
193
          WARNED=WARNED+1
194
194
        ENDIF
195
195
      ENDIF
264
264
        IF ((BUFF/REF).GT.THRES_FOURMOM) THEN
265
265
          IF (WARNED.LT.20) THEN
266
266
            BUFFDPA = (BUFF/REF)
267
 
            WRITE(*,*) 'ERROR:: Four-momentum conservation is no'
268
 
     $       //'t accurate enough, ',BUFFDPA
 
267
            WRITE(*,*) 'ERROR:: Four-momentum conservation is not'
 
268
     $       //' accurate enough, ',BUFFDPA
269
269
            CALL ML5_0_MP_WRITE_MOM(P)
270
270
            WARNED=WARNED+1
271
271
          ENDIF
275
275
      REF = REF / (ONE*NEXTERNAL)
276
276
      DO I=1,NEXTERNAL
277
277
        REF=ABS(P(0,I))+ABS(P(1,I))+ABS(P(2,I))+ABS(P(3,I))
278
 
        IF ((SQRT(ABS(P(0,I)**2-P(1,I)**2-P(2,I)**2-P(3,I)**2
279
 
     $   -MASSES(I)**2))/REF).GT.THRES_ONSHELL) THEN
 
278
        IF ((SQRT(ABS(P(0,I)**2-P(1,I)**2-P(2,I)**2-P(3,I)**2-MASSES(I)
 
279
     $   **2))/REF).GT.THRES_ONSHELL) THEN
280
280
          IF (WARNED.LT.20) THEN
281
281
            BUFFDPA=MASSES(I)
282
282
            BUFFDPB=(SQRT(ABS(P(0,I)**2-P(1,I)**2-P(2,I)**2-P(3,I)**2
283
283
     $       -MASSES(I)**2))/REF)
284
 
            WRITE(*,*) 'ERROR:: Onshellness of the momentum o'
285
 
     $       //'f particle ',I,' of mass ',BUFFDPA,' is not accurat'
286
 
     $       //'e enough, ',BUFFDPB
 
284
            WRITE(*,*) 'ERROR:: Onshellness of the momentum of'
 
285
     $       //' particle ',I,' of mass ',BUFFDPA,' is not accurate'
 
286
     $       //' enough, ',BUFFDPB
287
287
            CALL ML5_0_MP_WRITE_MOM(P)
288
288
            WARNED=WARNED+1
289
289
          ENDIF
322
322
      WRITE (*,*) '    ---------------------'
323
323
      WRITE (*,*) '    E | px | py | pz | m '
324
324
      DO I=1,NEXTERNAL
325
 
        WRITE (*,'(1x,5e27.17)') P(0,I),P(1,I),P(2,I),P(3,I),SQRT(ABS(M
326
 
     $   L5_0_MDOT(P(0,I),P(0,I))))
 
325
        WRITE (*,'(1x,5e27.17)') P(0,I),P(1,I),P(2,I),P(3,I)
 
326
     $   ,SQRT(ABS(ML5_0_MDOT(P(0,I),P(0,I))))
327
327
      ENDDO
328
328
      WRITE (*,*) '    Four-momentum conservation sum:'
329
329
      WRITE (*,'(1x,4e27.17)') PSUM(0),PSUM(1),PSUM(2),PSUM(3)
565
565
 
566
566
      IF (NINITIAL.NE.2) ERRCODE = 100
567
567
 
568
 
      IF (ABS(P(1,1)/REF).GT.THRS_TEST.OR.ABS(P(2,1)/REF).GT.THRS_TEST.
569
 
     $ OR.ABS(P(1,2)/REF).GT.THRS_TEST.OR.ABS(P(2,2)/REF).GT.THRS_TEST
570
 
     $ ) ERRCODE = 200
 
568
      IF (ABS(P(1,1)/REF).GT.THRS_TEST.OR.ABS(P(2,1)/REF)
 
569
     $ .GT.THRS_TEST.OR.ABS(P(1,2)/REF).GT.THRS_TEST.OR.ABS(P(2,2)/REF)
 
570
     $ .GT.THRS_TEST) ERRCODE = 200
571
571
 
572
572
      IF (MASSES(1).NE.ZERO.OR.MASSES(2).NE.ZERO) ERRCODE = 300
573
573
 
624
624
      DISCR = -PT(0)**2 + PT(1)**2 + PT(2)**2 + PT(3)**2
625
625
      IF (DISCR.LT.ZERO) DISCR = -DISCR
626
626
 
627
 
      SHIFTE(1) = (PT(0)*(-TWO*P(0,P1)*PT(0) + PT(0)**2 + PT(1)**2 
628
 
     $ + PT(2)**2) + (TWO*P(0,P1) - PT(0))*PT(3)**2 + PT(3)*DISCR)
629
 
     $ /(TWO*(PT(0) - PT(3))*(PT(0) + PT(3)))
630
 
      SHIFTE(2) = -(PT(0)*(TWO*P(0,P2)*PT(0) - PT(0)**2 + PT(1)**2 
631
 
     $ + PT(2)**2) + (-TWO*P(0,P2) + PT(0))*PT(3)**2 + PT(3)*DISCR)
 
627
      SHIFTE(1) = (PT(0)*(-TWO*P(0,P1)*PT(0) + PT(0)**2 + PT(1)**2 +
 
628
     $  PT(2)**2) + (TWO*P(0,P1) - PT(0))*PT(3)**2 + PT(3)*DISCR)/(TWO
 
629
     $ *(PT(0) - PT(3))*(PT(0) + PT(3)))
 
630
      SHIFTE(2) = -(PT(0)*(TWO*P(0,P2)*PT(0) - PT(0)**2 + PT(1)**2 +
 
631
     $  PT(2)**2) + (-TWO*P(0,P2) + PT(0))*PT(3)**2 + PT(3)*DISCR)
632
632
     $ /(TWO*(PT(0) - PT(3))*(PT(0) + PT(3)))
633
633
      SHIFTZ(1) = (-TWO*P(3,P1)*(PT(0)**2 - PT(3)**2) + PT(3)*(PT(0)*
634
634
     $ *2 + PT(1)**2 + PT(2)**2 - PT(3)**2) + PT(0)*DISCR)/(TWO*(PT(0)
635
635
     $ **2 - PT(3)**2))
636
 
      SHIFTZ(2) = -(TWO*P(3,P2)*(PT(0)**2 - PT(3)**2) + PT(3)*(
637
 
     $ -PT(0)**2 + PT(1)**2 + PT(2)**2 + PT(3)**2) + PT(0)*DISCR)/(TWO
638
 
     $ *(PT(0)**2 - PT(3)**2))
 
636
      SHIFTZ(2) = -(TWO*P(3,P2)*(PT(0)**2 - PT(3)**2) + PT(3)*(-PT(0)*
 
637
     $ *2 + PT(1)**2 + PT(2)**2 + PT(3)**2) + PT(0)*DISCR)/(TWO*(PT(0)
 
638
     $ **2 - PT(3)**2))
639
639
      NEWP(0,P1) = P(0,P1)+SHIFTE(1)
640
640
      NEWP(3,P1) = P(3,P1)+SHIFTZ(1)
641
641
      NEWP(0,P2) = P(0,P2)+SHIFTE(2)
768
768
        ENDIF
769
769
      ENDDO
770
770
      IF (WARNED.LT.20) THEN
771
 
        WRITE(*,*) 'WARNING:: Could not find the proper rescalin'
772
 
     $   //'g factor x. Restoring precision ala PSMC will therefor'
773
 
     $   //'e not be used.'
 
771
        WRITE(*,*) 'WARNING:: Could not find the proper rescaling'
 
772
     $   //' factor x. Restoring precision ala PSMC will therefore not'
 
773
     $   //' be used.'
774
774
        WARNED=WARNED+1
775
775
      ENDIF
776
776
      IF (ERRCODE.LT.1000) THEN
809
809
      ENDDO
810
810
      IF ((ABS(BUFF)/BUFF2).GT.CONSISTENCY_THRES) THEN
811
811
        IF (WARNED.LT.20) THEN
812
 
          WRITE(*,*) 'WARNING:: The consistency check in the a la PSM'
813
 
     $     //'C precision restoring algorithm failed. The result wil'
814
 
     $     //'l therefore not be used.'
 
812
          WRITE(*,*) 'WARNING:: The consistency check in the a la PSMC'
 
813
     $     //' precision restoring algorithm failed. The result will'
 
814
     $     //' therefore not be used.'
815
815
          WARNED=WARNED+1
816
816
        ENDIF
817
817
        ERRCODE = 1000