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.'
113
113
IF (IMPROVEPSPOINT.EQ.1) THEN
114
CALL ML5_0_MP_ORIG_IMPROVE_PS_POINT_PRECISION(NEWP,ERRCODETMP
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
117
CALL ML5_0_MP_PSMC_IMPROVE_PS_POINT_PRECISION(NEWP
118
$ ,ERRCODETMP,WARNED)
120
120
IF (ERRCODETMP.NE.0) GOTO 100
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
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.
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
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)
275
275
REF = REF / (ONE*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)
322
322
WRITE (*,*) ' ---------------------'
323
323
WRITE (*,*) ' E | px | py | pz | m '
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))))
328
328
WRITE (*,*) ' Four-momentum conservation sum:'
329
329
WRITE (*,'(1x,4e27.17)') PSUM(0),PSUM(1),PSUM(2),PSUM(3)
566
566
IF (NINITIAL.NE.2) ERRCODE = 100
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
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
572
572
IF (MASSES(1).NE.ZERO.OR.MASSES(2).NE.ZERO) ERRCODE = 300
624
624
DISCR = -PT(0)**2 + PT(1)**2 + PT(2)**2 + PT(3)**2
625
625
IF (DISCR.LT.ZERO) DISCR = -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)
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)
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)
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'
771
WRITE(*,*) 'WARNING:: Could not find the proper rescaling'
772
$ //' factor x. Restoring precision ala PSMC will therefore not'
776
776
IF (ERRCODE.LT.1000) THEN
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.'