JHUGen MELA  JHUGen v7.5.6, MELA v2.4.2
Matrix element calculations as used in JHUGen.
Functions/Subroutines
collier_aux Module Reference

Functions/Subroutines

subroutine checkcoefsa_cll (A, A2, m02, rmax, norm0, Adiff)
 
subroutine checkcoefsb_cll (B, B2, p10, m02, m12, rmax, norm0, Bdiff)
 
subroutine checkcoefsc_cll (C, C2, p10, p21, p20, m02, m12, m22, rmax, norm0, Cdiff)
 
subroutine checkcoefsd_cll (D, D2, p10, p21, p32, p30, p20, p31, m02, m12, m22, m32, rmax, norm0, Ddiff)
 
subroutine checkcoefse_cll (E, E2, p10, p21, p32, p43, p40, p20, p31, p42, p30, p41, m02, m12, m22, m32, m42, rmax, norm0, Ediff)
 
subroutine checkcoefsf_cll (F, F2, p10, p21, p32, p43, p54, p50, p20, p31, p42, p53, p40, p51, p30, p41, p52, m02, m12, m22, m32, m42, m52, rmax, norm0, Fdiff)
 
subroutine checkcoefstn_cll (TN, TN2, MomInv, masses2, N, rmax, norm0, TNdiff)
 
subroutine checkcoefsdbr_cll (DB, DB2, p10, m02, m12, r)
 
subroutine checkcoefsdb_cll (DB, DB2, p10, m02, m12, rmax, norm0, DBdiff)
 
subroutine errout_cll (sub, err, flag, nomaster)
 
subroutine critpointsout_cll (sub, N, acc, cntr)
 
subroutine critpointsout2_cll (sub, N, acc, cntr)
 
subroutine printstatistics_cll ()
 
subroutine printstatistics2_cll ()
 
recursive double complex function contractlostruc (Nm1, struc1, struc2, Gram)
 
double complex function, dimension(0:rmax/2, binomtable(rmax, nm1+rmax-1), 0:rmax/2, binomtable(rmax, nm1+rmax-1), 0:rmax) lostrucconts (Nm1, rmax, Gram)
 
double complex function, dimension(n-1, n-1) calcgram (N, MomInv)
 

Function/Subroutine Documentation

◆ calcgram()

double complex function, dimension(n-1,n-1) collier_aux::calcgram ( integer, intent(in)  N,
double complex, dimension(binomtable(2,n)), intent(in)  MomInv 
)

Definition at line 2723 of file collier_aux.F90.

2723 
2724  integer, intent(in) :: N
2725  double complex, intent(in) :: MomInv(BinomTable(2,N))
2726  double complex :: MomInvInf(BinomTable(2,N)),elimminf2_coli
2727  double complex :: Gram(N-1,N-1)
2728  integer :: i,j,cnt
2729 
2730 
2731  do i=1,binomtable(2,n)
2732  mominvinf(i) = elimminf2_coli(mominv(i))
2733  end do
2734 
2735 
2736  cnt = 1
2737  do i=1,n/2
2738  gram(i,i) = mominvinf(cnt)
2739  cnt = cnt+1
2740 
2741  do j=i+1,n-1
2742  gram(j-i,j) = mominvinf(cnt)
2743  cnt = cnt+1
2744  end do
2745  if (cnt.gt.binomtable(2,n)) exit
2746 
2747  gram(n-i,n-i) = mominvinf(cnt)
2748  cnt = cnt+1
2749 
2750  do j=1,i-1
2751  gram(j,n-i+j) = mominvinf(cnt)
2752  cnt = cnt+1
2753  end do
2754  end do
2755 
2756  do i=1,n-1
2757  do j=i+1,n-1
2758  gram(i,j) = -(gram(i,j)-gram(i,i)-gram(j,j))/2d0
2759  gram(j,i) = gram(i,j)
2760  end do
2761  end do
2762 

◆ checkcoefsa_cll()

subroutine collier_aux::checkcoefsa_cll ( double complex, dimension(0:rmax/2), intent(in)  A,
double complex, dimension(0:rmax/2), intent(in)  A2,
double complex, intent(in)  m02,
integer, intent(in)  rmax,
double precision, intent(in)  norm0,
double precision, dimension(0:rmax), intent(out)  Adiff 
)

Definition at line 42 of file collier_aux.F90.

42 
43  integer, intent(in) :: rmax
44  double complex, intent(in) :: m02
45  double complex, intent(in) :: A(0:rmax/2),A2(0:rmax/2)
46  double precision, intent(in) :: norm0
47  double precision, intent(out) :: Adiff(0:rmax)
48  double complex :: diffA
49  double precision :: norm,ratio
50  integer :: n0,i,flag
51 ! integer, parameter :: noutCheckAmax=50
52 ! integer, save :: DiffCntA
53 
54  character(len=*),parameter :: fmt1 = "(A5,'dcmplx(',d25.18,' ,',d25.18,' )')"
55  character(len=*),parameter :: fmt2 = &
56  "(A6,' A(',i1,') = (',E23.16,' , ',E23.16,' )')"
57 
58 ! data DiffCntA /0/
59 
60  checkcnt_cll(1) = checkcnt_cll(1) + 1
61 
62  flag=1
63  if(diffcnt_cll(1).ge.maxcheck_cll(1)) flag=0
64  if(ncheckout_cll.eq.closed_cll) flag=0
65  ratio=0d0
66 
67  adiff=0d0
68  do n0=0,rmax/2
69 ! norm = min(abs(A(n0)),abs(A2(n0)))
70  if (m02.ne.0d0) then
71  norm = norm0*abs(m02)**(n0)
72  else
73  norm = norm0**(n0+1)
74  endif
75  diffa = a(n0)-a2(n0)
76  adiff(2*n0) = max(adiff(2*n0),abs(diffa))
77  if ((abs(diffa).gt.checkacc_cll*norm).and.(flag.eq.1)) then
78  write(ncheckout_cll,*) '*************************************************************************'
79  write(ncheckout_cll,*) 'A difference NO.', diffcnt_cll(1)+1
80  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
81  write(ncheckout_cll,'(A21,I2,A4,I2)') 'A integral with rank', 2*n0,' of ',rmax
82  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
83  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
84  write(ncheckout_cll,*) 'mode ', mode_cll
85  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
86  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
87  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
88  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
89  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
90  write(ncheckout_cll,*) 'nminf ', nminf_cll
91  do i=1,nminf_cll
92  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
93  end do
94  write(ncheckout_cll,*) 'dprec ', dprec_cll
95  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
96  write(ncheckout_cll,*) 'critacc ', critacc_cll
97  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
98  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
99  write(ncheckout_cll,*) '------------------------------------------------------------'
100  write(ncheckout_cll,fmt1) 'm02=', m02
101  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
102  write(ncheckout_cll,fmt2) 'COLI:',0,a(0)
103  write(ncheckout_cll,fmt2) 'DD :',0,a2(0)
104  write(ncheckout_cll,fmt2) 'COLI:',n0,a(n0)
105  write(ncheckout_cll,fmt2) 'DD :',n0,a2(n0)
106  write(ncheckout_cll,*) 'diff:', abs(diffa)/norm
107  flag=2
108  ratio=abs(diffa)/norm
109  elseif((flag.eq.2).and.(abs(diffa).gt.ratio*norm)) then
110  write(ncheckout_cll,fmt2) 'COLI:',n0,a(n0)
111  write(ncheckout_cll,fmt2) 'DD :',n0,a2(n0)
112  write(ncheckout_cll,*) 'diff:', abs(diffa)/norm
113  ratio=abs(diffa)/norm
114  write(ncheckout_cll,*) 'COLI:', a(n0)
115  elseif ((abs(diffa).gt.checkacc_cll*norm).and.(flag.eq.0)) then
116  flag=3
117  end if
118  end do
119  if(flag.eq.2)then
120  write(ncheckout_cll,*) '*************************************************************************'
121  write(ncheckout_cll,*)
122  write(ncheckout_cll,*)
123  diffcnt_cll(1) = diffcnt_cll(1) + 1
124  if(diffcnt_cll(1).eq.maxcheck_cll(1)) then
125  write(ncheckout_cll,*) ' Further output for differences in A functions suppressed '
126  write(ncheckout_cll,*)
127  endif
128  elseif(flag.eq.3)then
129  diffcnt_cll(1) = diffcnt_cll(1) + 1
130  end if
131 
132 

◆ checkcoefsb_cll()

subroutine collier_aux::checkcoefsb_cll ( double complex, dimension(0:rmax/2,0:rmax), intent(in)  B,
double complex, dimension(0:rmax/2,0:rmax), intent(in)  B2,
double complex, intent(in)  p10,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
integer, intent(in)  rmax,
double precision, intent(in)  norm0,
double precision, dimension(0:rmax), intent(out)  Bdiff 
)

Definition at line 145 of file collier_aux.F90.

145 
146  integer, intent(in) :: rmax
147  double complex, intent(in) :: p10,m02,m12
148  double complex, intent(in) :: B(0:rmax/2,0:rmax),B2(0:rmax/2,0:rmax)
149  double precision, intent(in) :: norm0
150  double precision, intent(out) :: Bdiff(0:rmax)
151  double complex :: diffB
152  double precision :: norm,ratio
153  integer :: r,n0,n1,i,flag
154 ! integer, parameter :: noutCheckBmax=50
155 ! integer, save :: DiffCntB
156 
157  character(len=*),parameter :: fmt1 = "(A6,'dcmplx(',d25.18,' ,',d25.18,' )')"
158  character(len=*),parameter :: fmt2 = &
159  "(A6,' B(',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
160 
161 ! data DiffCntB /0/
162 
163  checkcnt_cll(2) = checkcnt_cll(2) + 1
164 
165  flag=1
166  if(diffcnt_cll(2).ge.maxcheck_cll(2)) flag=0
167  if(ncheckout_cll.eq.closed_cll) flag=0
168  ratio=0d0
169 
170  bdiff=0d0
171  do r=0,rmax
172  do n0=0,r/2
173  n1 = r-2*n0
174 ! norm = min(abs(B(n0,n1)),abs(B2(n0,n1)))
175  if (max(abs(p10),abs(m02),abs(m12)).ne.0d0) then
176  norm = norm0*max(abs(p10),abs(m02),abs(m12))**n0
177  else
178  norm = norm0*muuv2_cll**n0
179  end if
180  diffb = b(n0,n1)-b2(n0,n1)
181  if (n0.eq.0) bdiff(r) = max(bdiff(r),abs(diffb))
182  if ((abs(diffb).gt.checkacc_cll*norm).and.(flag.eq.1)) then
183  write(ncheckout_cll,*) '*************************************************************************'
184  write(ncheckout_cll,*) 'B difference NO.', diffcnt_cll(2)+1
185  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
186  write(ncheckout_cll,'(A21,I2,A4,I2)') 'B integral with rank', r,' of ',rmax
187  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
188  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
189  write(ncheckout_cll,*) 'mode ', mode_cll
190  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
191  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
192  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
193  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
194  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
195  write(ncheckout_cll,*) 'nminf ', nminf_cll
196  do i=1,nminf_cll
197  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
198  end do
199  write(ncheckout_cll,*) 'dprec ', dprec_cll
200  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
201  write(ncheckout_cll,*) 'critacc ', critacc_cll
202  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
203  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
204  write(ncheckout_cll,*) '------------------------------------------------------------'
205 ! write(ncheckout_cll,*) 'n0', n0
206 ! write(ncheckout_cll,*) 'n1', n1
207 ! write(ncheckout_cll,*) '-------------------------------------------------------------------------'
208  write(ncheckout_cll,fmt1) 'p10=', p10
209  write(ncheckout_cll,fmt1) 'm02=', m02
210  write(ncheckout_cll,fmt1) 'm12=', m12
211  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
212 ! write(ncheckout_cll,*) 'C0_coli:', B(0,0)
213 ! write(ncheckout_cll,*) 'C0_DD :', B2(0,0)
214  write(ncheckout_cll,fmt2) 'COLI:',0,0,b(0,0)
215  write(ncheckout_cll,fmt2) 'DD :',0,0,b2(0,0)
216  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,b(n0,n1)
217  write(ncheckout_cll,fmt2) 'DD :',n0,n1,b2(n0,n1)
218 ! write(ncheckout_cll,*) 'COLI:', B(n0,n1)
219 ! write(ncheckout_cll,*) 'DD :', B2(n0,n1)
220  write(ncheckout_cll,*) 'diff:', abs(diffb)/norm
221  flag=2
222  ratio=abs(diffb)/norm
223  elseif((flag.eq.2).and.(abs(diffb).gt.ratio*norm)) then
224  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,b(n0,n1)
225  write(ncheckout_cll,fmt2) 'DD :',n0,n1,b2(n0,n1)
226  write(ncheckout_cll,*) 'diff:', abs(diffb)/norm
227  ratio=abs(diffb)/norm
228  elseif ((abs(diffb).gt.checkacc_cll*norm).and.(flag.eq.0)) then
229  flag=3
230  end if
231  end do
232  end do
233  if(flag.eq.2)then
234  write(ncheckout_cll,*) '*************************************************************************'
235  write(ncheckout_cll,*) ' end B'
236  write(ncheckout_cll,*)
237  diffcnt_cll(2) = diffcnt_cll(2) + 1
238  if(diffcnt_cll(2).eq.maxcheck_cll(2)) then
239  write(ncheckout_cll,*) ' Further output for differences in B functions suppressed '
240  write(ncheckout_cll,*)
241  endif
242  elseif(flag.eq.3)then
243  diffcnt_cll(2) = diffcnt_cll(2) + 1
244  end if
245 
246 

◆ checkcoefsc_cll()

subroutine collier_aux::checkcoefsc_cll ( double complex, dimension(0:rmax/2,0:rmax,0:rmax), intent(in)  C,
double complex, dimension(0:rmax/2,0:rmax,0:rmax), intent(in)  C2,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p20,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
integer, intent(in)  rmax,
double precision, intent(in)  norm0,
double precision, dimension(0:rmax), intent(out)  Cdiff 
)

Definition at line 259 of file collier_aux.F90.

259 
260  integer, intent(in) :: rmax
261  double complex, intent(in) :: p10,p21,p20,m02,m12,m22
262  double complex, intent(in) :: C(0:rmax/2,0:rmax,0:rmax),C2(0:rmax/2,0:rmax,0:rmax)
263  double precision, intent(in) :: norm0
264  double precision, intent(out) :: Cdiff(0:rmax)
265  double complex :: diffC
266  double precision :: norm,ratio
267  integer :: r,n0,n1,n2,i,flag
268 ! integer, parameter :: noutCheckCmax=50
269 ! integer, save :: DiffCntC
270 
271  character(len=*),parameter :: fmt1 = "(A5,'dcmplx(',d25.18,' ,',d25.18,' )')"
272  character(len=*),parameter :: fmt2 = &
273  "(A6,' C(',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
274 
275 ! data DiffCntC /0/
276 
277  checkcnt_cll(3) = checkcnt_cll(3) + 1
278 
279  flag=1
280  if(diffcnt_cll(3).ge.maxcheck_cll(3)) flag=0
281  if(ncheckout_cll.eq.closed_cll) flag=0
282  ratio=0d0
283 
284  cdiff = 0d0
285  do r=0,rmax
286  do n0=0,r/2
287  do n1=0,r-2*n0
288  n2 = r-2*n0-n1
289 ! norm = min(abs(C(n0,n1,n2)),abs(C2(n0,n1,n2)))
290  norm = norm0/norm0**n0
291  diffc = c(n0,n1,n2)-c2(n0,n1,n2)
292  if (n0.eq.0) cdiff(r) = max(cdiff(r),abs(diffc))
293  if ((abs(diffc).gt.checkacc_cll*norm).and.(flag.eq.1)) then
294  write(ncheckout_cll,*) '*************************************************************************'
295  write(ncheckout_cll,*) 'C difference NO.', diffcnt_cll(3)+1
296  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
297  write(ncheckout_cll,'(A21,I2,A4,I2)') 'C integral with rank', r,' of ',rmax
298 ! write(ncheckout_cll,*) '-------------------------------------------------------------------------'
299 ! write(ncheckout_cll,*) 'n0', n0
300 ! write(ncheckout_cll,*) 'n1', n1
301 ! write(ncheckout_cll,*) 'n2', n2
302  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
303  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
304  write(ncheckout_cll,*) 'mode ', mode_cll
305  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
306  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
307  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
308  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
309  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
310  write(ncheckout_cll,*) 'nminf ', nminf_cll
311  do i=1,nminf_cll
312  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
313  end do
314  write(ncheckout_cll,*) 'dprec ', dprec_cll
315  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
316  write(ncheckout_cll,*) 'critacc ', critacc_cll
317  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
318  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
319  write(ncheckout_cll,*) '------------------------------------------------------------'
320  write(ncheckout_cll,fmt1) 'p10=', p10
321  write(ncheckout_cll,fmt1) 'p21=', p21
322  write(ncheckout_cll,fmt1) 'p20=', p20
323  write(ncheckout_cll,fmt1) 'm02=', m02
324  write(ncheckout_cll,fmt1) 'm12=', m12
325  write(ncheckout_cll,fmt1) 'm22=', m22
326  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
327 ! write(ncheckout_cll,*) 'C0_coli:', C(0,0,0)
328 ! write(ncheckout_cll,*) 'C0_DD :', C2(0,0,0)
329  write(ncheckout_cll,fmt2) 'COLI:',0,0,0,c(0,0,0)
330  write(ncheckout_cll,fmt2) 'DD :',0,0,0,c2(0,0,0)
331  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,c(n0,n1,n2)
332  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,c2(n0,n1,n2)
333 ! write(ncheckout_cll,*) 'COLI:', C(n0,n1,n2)
334 ! write(ncheckout_cll,*) 'DD :', C2(n0,n1,n2)
335  write(ncheckout_cll,*) 'diff:', abs(diffc)/norm
336  flag=2
337  ratio=abs(diffc)/norm
338  elseif((flag.eq.2).and.(abs(diffc).gt.ratio*norm)) then
339  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,c(n0,n1,n2)
340  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,c2(n0,n1,n2)
341  write(ncheckout_cll,*) 'diff:', abs(diffc)/norm
342  ratio=abs(diffc)/norm
343  elseif ((abs(diffc).gt.checkacc_cll*norm).and.(flag.eq.0)) then
344  flag=3
345  end if
346  end do
347  end do
348  end do
349  if(flag.eq.2)then
350  write(ncheckout_cll,*) '*************************************************************************'
351  write(ncheckout_cll,*) ' end C'
352  write(ncheckout_cll,*)
353  diffcnt_cll(3) = diffcnt_cll(3) + 1
354  if(diffcnt_cll(3).eq.maxcheck_cll(3)) then
355  write(ncheckout_cll,*) ' Further output for differences in C functions suppressed '
356  write(ncheckout_cll,*)
357  endif
358  elseif(flag.eq.3)then
359  diffcnt_cll(3) = diffcnt_cll(3) + 1
360  endif
361 
362 

◆ checkcoefsd_cll()

subroutine collier_aux::checkcoefsd_cll ( double complex, dimension(0:rmax/2,0:rmax,0:rmax,0:rmax), intent(in)  D,
double complex, dimension(0:rmax/2,0:rmax,0:rmax,0:rmax), intent(in)  D2,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p30,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
integer, intent(in)  rmax,
double precision, intent(in)  norm0,
double precision, dimension(0:rmax), intent(out)  Ddiff 
)

Definition at line 377 of file collier_aux.F90.

377 
378  integer, intent(in) :: rmax
379  double complex, intent(in) :: p10,p21,p32,p30,p20,p31,m02,m12,m22,m32
380  double complex, intent(in) :: D(0:rmax/2,0:rmax,0:rmax,0:rmax)
381  double complex, intent(in) :: D2(0:rmax/2,0:rmax,0:rmax,0:rmax)
382  double precision, intent(in) :: norm0
383  double precision, intent(out) :: Ddiff(0:rmax)
384  double complex :: diffD
385  double precision :: norm,ratio
386  integer :: r,n0,n1,n2,n3,i,flag
387 ! integer, parameter :: noutCheckDmax=50
388 ! integer, save :: DiffCntD
389 
390  character(len=*),parameter :: fmt1 = "(A5,'dcmplx(',d25.18,' ,',d25.18,' )')"
391  character(len=*),parameter :: fmt2 = &
392  "(A6,' D(',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
393 
394 ! data DiffCntD /0/
395 
396  checkcnt_cll(4) = checkcnt_cll(4) + 1
397 
398  flag=1
399  if(diffcnt_cll(4).ge.maxcheck_cll(4)) flag=0
400  if(ncheckout_cll.eq.closed_cll) flag=0
401  ratio=0d0
402 
403  ddiff = 0d0
404  do r=0,rmax
405  do n0=0,r/2
406  do n1=0,r-2*n0
407  do n2=0,r-2*n0-n1
408  n3 = r-2*n0-n1-n2
409 ! norm = min(abs(D(n0,n1,n2,n3)),abs(D2(n0,n1,n2,n3)))
410  norm = norm0/sqrt(norm0)**n0
411  diffd = d(n0,n1,n2,n3)-d2(n0,n1,n2,n3)
412  if (n0.eq.0) ddiff(r) = max(ddiff(r),abs(diffd))
413  if ((abs(diffd).gt.checkacc_cll*norm).and.(flag.eq.1)) then
414  write(ncheckout_cll,*) '*************************************************************************'
415  write(ncheckout_cll,*) 'D difference NO.', diffcnt_cll(4)+1
416  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
417  write(ncheckout_cll,'(A21,I2,A4,I2)') 'D integral with rank', r,' of ',rmax
418 ! write(ncheckout_cll,*) '-------------------------------------------------------------------------'
419 ! write(ncheckout_cll,*) 'n0', n0
420 ! write(ncheckout_cll,*) 'n1', n1
421 ! write(ncheckout_cll,*) 'n2', n2
422 ! write(ncheckout_cll,*) 'n3', n3
423  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
424  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
425  write(ncheckout_cll,*) 'mode ', mode_cll
426  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
427  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
428  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
429  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
430  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
431  write(ncheckout_cll,*) 'nminf ', nminf_cll
432  do i=1,nminf_cll
433  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
434  end do
435  write(ncheckout_cll,*) 'dprec ', dprec_cll
436  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
437  write(ncheckout_cll,*) 'critacc ', critacc_cll
438  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
439  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
440  write(ncheckout_cll,*) '------------------------------------------------------------'
441  write(ncheckout_cll,fmt1) 'p10=', p10
442  write(ncheckout_cll,fmt1) 'p21=', p21
443  write(ncheckout_cll,fmt1) 'p32=', p32
444  write(ncheckout_cll,fmt1) 'p30=', p30
445  write(ncheckout_cll,fmt1) 'p20=', p20
446  write(ncheckout_cll,fmt1) 'p31=', p31
447  write(ncheckout_cll,fmt1) 'm02=', m02
448  write(ncheckout_cll,fmt1) 'm12=', m12
449  write(ncheckout_cll,fmt1) 'm22=', m22
450  write(ncheckout_cll,fmt1) 'm32=', m32
451  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
452 ! write(ncheckout_cll,*) 'D0_coli:', D(0,0,0,0)
453 ! write(ncheckout_cll,*) 'D0_DD :', D2(0,0,0,0)
454  write(ncheckout_cll,fmt2) 'COLI:',0,0,0,0,d(0,0,0,0)
455  write(ncheckout_cll,fmt2) 'DD :',0,0,0,0,d2(0,0,0,0)
456  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,d(n0,n1,n2,n3)
457  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,d2(n0,n1,n2,n3)
458 ! write(ncheckout_cll,*) 'COLI:', D(n0,n1,n2,n3)
459 ! write(ncheckout_cll,*) 'DD :', D2(n0,n1,n2,n3)
460  if(norm.ne.0d0)then
461  write(ncheckout_cll,*) 'diff:', abs(diffd)/norm
462  ratio=abs(diffd)/norm
463  else
464  write(ncheckout_cll,*) 'diff:', 1d50
465  ratio=1d50
466  endif
467  flag=2
468  elseif((flag.eq.2).and.(abs(diffd).gt.ratio*norm)) then
469  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,d(n0,n1,n2,n3)
470  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,d2(n0,n1,n2,n3)
471  if(norm.gt.1d-100)then
472  write(ncheckout_cll,*) 'diff:', abs(diffd)/norm
473  ratio=abs(diffd)/norm
474  else
475  write(ncheckout_cll,*) 'diff:', 1d50
476  ratio=1d50
477  endif
478  elseif ((abs(diffd).gt.checkacc_cll*norm).and.(flag.eq.0)) then
479  flag=3
480  end if
481  end do
482  end do
483  end do
484  end do
485  if(flag.eq.2)then
486  write(ncheckout_cll,*) '*************************************************************************'
487  write(ncheckout_cll,*) ' end D '
488  write(ncheckout_cll,*)
489  diffcnt_cll(4) = diffcnt_cll(4) + 1
490  if(diffcnt_cll(4).eq.maxcheck_cll(4)) then
491  write(ncheckout_cll,*) ' Further output for differences in D functions suppressed '
492  write(ncheckout_cll,*)
493  endif
494  elseif(flag.eq.3)then
495  diffcnt_cll(4) = diffcnt_cll(4) + 1
496  endif
497 
498 

◆ checkcoefsdb_cll()

subroutine collier_aux::checkcoefsdb_cll ( double complex, dimension(0:rmax/2,0:rmax), intent(in)  DB,
double complex, dimension(0:rmax/2,0:rmax), intent(in)  DB2,
double complex, intent(in)  p10,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
integer, intent(in)  rmax,
double precision, intent(in)  norm0,
double precision, dimension(0:rmax), intent(out)  DBdiff 
)

Definition at line 1406 of file collier_aux.F90.

1406 
1407  integer, intent(in) :: rmax
1408  double complex, intent(in) :: p10,m02,m12
1409  double complex, intent(in) :: DB(0:rmax/2,0:rmax),DB2(0:rmax/2,0:rmax)
1410  double precision, intent(in) :: norm0
1411  double precision, intent(out) :: DBdiff(0:rmax)
1412  double complex :: diffDB
1413  double precision :: norm,ratio
1414  integer :: r,n0,n1,i
1415  integer :: flag
1416 ! integer, parameter :: noutCheckDBmax=50
1417 ! integer, save :: DiffCntDB
1418 
1419  character(len=*),parameter :: fmt1 = "(A6,'dcmplx(',d25.18,' ,',d25.18,' )')"
1420  character(len=*),parameter :: fmt2 = &
1421  "(A6,' DB(',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
1422 
1423 ! data DiffCntDB /0/
1424 
1425 ! DiffCntDB = DiffCntDB + 1
1426 
1427  checkcntdb_cll = checkcntdb_cll + 1
1428 
1429  flag=1
1430  if(diffcntdb_cll.ge.maxcheckdb_cll) flag=0
1431  if(ncheckout_cll.eq.closed_cll) flag=0
1432  ratio=0d0
1433 
1434  dbdiff=0d0
1435  do r=0,rmax
1436  do n0=0,r/2
1437  n1 = r-2*n0
1438 ! norm = min(abs(DB(n0,n1)),abs(DB2(n0,n1)))
1439  norm = norm0/norm0**n0
1440  diffdb = db(n0,n1)-db2(n0,n1)
1441  if (n0.eq.0) dbdiff(r) = max(dbdiff(r),abs(diffdb))
1442  if ((abs(diffdb).gt.checkacc_cll*norm).and.(flag.eq.1)) then
1443  write(ncheckout_cll,*) '*************************************************************************'
1444  write(ncheckout_cll,*) 'DB difference NO.', diffcntdb_cll+1
1445  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
1446  write(ncheckout_cll,'(A21,I2,A4,I2)') 'DB integral with rank', r,' of ',rmax
1447  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
1448  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
1449  write(ncheckout_cll,*) 'mode ', mode_cll
1450  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
1451  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
1452  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
1453  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
1454  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
1455  write(ncheckout_cll,*) 'nminf ', nminf_cll
1456  do i=1,nminf_cll
1457  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
1458  end do
1459  write(ncheckout_cll,*) 'dprec ', dprec_cll
1460  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
1461  write(ncheckout_cll,*) 'critacc ', critacc_cll
1462  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
1463  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
1464  write(ncheckout_cll,*) '------------------------------------------------------------'
1465 ! write(ncheckout_cll,*) 'n0', n0
1466 ! write(ncheckout_cll,*) 'n1', n1
1467 ! write(ncheckout_cll,*) '-------------------------------------------------------------------------'
1468  write(ncheckout_cll,fmt1) 'p10=', p10
1469  write(ncheckout_cll,fmt1) 'm02=', m02
1470  write(ncheckout_cll,fmt1) 'm12=', m12
1471  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
1472 ! write(ncheckout_cll,*) 'C0_coli:', DB(0,0)
1473 ! write(ncheckout_cll,*) 'C0_DD :', DB2(0,0)
1474  write(ncheckout_cll,fmt2) 'COLI:',0,0,db(0,0)
1475  write(ncheckout_cll,fmt2) 'DD :',0,0,db2(0,0)
1476  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,db(n0,n1)
1477  write(ncheckout_cll,fmt2) 'DD :',n0,n1,db2(n0,n1)
1478 ! write(ncheckout_cll,*) 'COLI:', DB(n0,n1)
1479 ! write(ncheckout_cll,*) 'DD :', DB2(n0,n1)
1480  write(ncheckout_cll,*) 'diff:', abs(diffdb)/norm
1481  flag=2
1482  ratio=abs(diffdb)/norm
1483  elseif((flag.eq.2).and.(abs(diffdb).gt.ratio*norm)) then
1484  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,db(n0,n1)
1485  write(ncheckout_cll,fmt2) 'DD :',n0,n1,db2(n0,n1)
1486  write(ncheckout_cll,*) 'diff:', abs(diffdb)/norm
1487  ratio=abs(diffdb)/norm
1488  elseif ((abs(diffdb).gt.checkacc_cll*norm).and.(flag.eq.0)) then
1489  flag=3
1490  end if
1491  end do
1492  end do
1493  if(flag.eq.2)then
1494  write(ncheckout_cll,*) '*************************************************************************'
1495  write(ncheckout_cll,*) ' end B'
1496  write(ncheckout_cll,*)
1497  diffcntdb_cll = diffcntdb_cll + 1
1498  if(diffcntdb_cll.ge.maxcheckdb_cll) then
1499  write(ncheckout_cll,*) ' Further output for differences in B functions suppressed '
1500  write(ncheckout_cll,*)
1501  endif
1502  elseif(flag.eq.3)then
1503  diffcntdb_cll = diffcntdb_cll + 1
1504  end if
1505 
1506 

◆ checkcoefsdbr_cll()

subroutine collier_aux::checkcoefsdbr_cll ( double complex, intent(in)  DB,
double complex, intent(in)  DB2,
double complex, intent(in)  p10,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
integer, intent(in)  r 
)

Definition at line 1340 of file collier_aux.F90.

1340 
1341  integer, intent(in) :: r
1342  double complex, intent(in) :: p10,m02,m12
1343  double complex, intent(in) :: DB,DB2
1344  double complex :: diffB
1345  double precision :: norm
1346  integer :: flag
1347 ! integer, parameter :: noutCheckDBmax=50
1348 ! integer, save :: DiffCntDB
1349 
1350  character(len=*),parameter :: fmt1 = "(A5,'dcmplx(',g25.18,',',g25.18,' )')"
1351 
1352 ! data DiffCntDB /0/
1353 
1354 
1355  checkcntdb_cll = checkcntdb_cll + 1
1356 
1357  flag=1
1358  if(diffcntdb_cll.ge.maxcheckdb_cll) flag=0
1359  if(ncheckout_cll.eq.closed_cll) flag=0
1360 
1361  norm = min(abs(db),abs(db2))
1362  diffb = db-db2
1363  if ((abs(diffb).gt.checkacc_cll*norm)) then
1364  if (flag.eq.1) then
1365  write(ncheckout_cll,*) '*************************************************************************'
1366  write(ncheckout_cll,*) 'DB difference NO.', diffcntdb_cll+1
1367  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
1368  select case (r)
1369  case (0)
1370  write(ncheckout_cll,*) 'integral DB0'
1371  case (1)
1372  write(ncheckout_cll,*) 'integral DB1'
1373  case (2)
1374  write(ncheckout_cll,*) 'integral DB00'
1375  end select
1376  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
1377  write(ncheckout_cll,fmt1) 'p10=', p10
1378  write(ncheckout_cll,fmt1) 'm02=', m02
1379  write(ncheckout_cll,fmt1) 'm12=', m12
1380  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
1381  write(ncheckout_cll,*) 'COLI:', db
1382  write(ncheckout_cll,*) 'DD :', db2
1383  write(ncheckout_cll,*) '*************************************************************************'
1384  write(ncheckout_cll,*)
1385  write(ncheckout_cll,*)
1386  end if
1387  diffcntdb_cll = diffcntdb_cll + 1
1388  if(diffcntdb_cll.eq.maxcheckdb_cll) then
1389  write(ncheckout_cll,*) ' Further output for differences in DB functions suppressed '
1390  write(ncheckout_cll,*)
1391  endif
1392  end if
1393 
1394 

◆ checkcoefse_cll()

subroutine collier_aux::checkcoefse_cll ( double complex, dimension(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax), intent(in)  E,
double complex, dimension(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax), intent(in)  E2,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p43,
double complex, intent(in)  p40,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  p42,
double complex, intent(in)  p30,
double complex, intent(in)  p41,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
double complex, intent(in)  m42,
integer, intent(in)  rmax,
double precision, intent(in)  norm0,
double precision, dimension(0:rmax), intent(out)  Ediff 
)

Definition at line 515 of file collier_aux.F90.

515 
516  integer, intent(in) :: rmax
517  double complex, intent(in) :: p10,p21,p32,p43,p40,p20,p31,p42,p30,p41
518  double complex, intent(in) :: m02,m12,m22,m32,m42
519  double complex, intent(in) :: E(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
520  double complex, intent(in) :: E2(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax)
521  double precision, intent(in) :: norm0
522  double precision, intent(out) :: Ediff(0:rmax)
523  double complex :: Gram(4,4),diffE
524  double complex :: Ep(BinomTable(rmax,rmax+3)),Ep2(BinomTable(rmax,rmax+3)),diffEp(BinomTable(rmax,rmax+3))
525  double precision :: norm,ratio
526 ! double precision :: norm,ratio,Zmax
527  integer :: r,n0,n1,n2,n3,n4,m0,m1,m2,m3,m4,i,flag,flagEc
528  integer :: struc1(BinomTable(rmax,rmax+3),0:4), struc2(0:4)
529 ! integer, parameter :: noutCheckEmax=50
530 ! integer, save :: DiffCntE
531 
532  double complex :: LoCons(0:rmax/2,BinomTable(rmax,rmax+3),0:rmax/2,BinomTable(rmax,rmax+3),0:rmax)
533  integer :: i1,i2
534 
535  character(len=*),parameter :: fmt1 = "(A5,'dcmplx(',d25.18,',',d25.18,' )')"
536  character(len=*),parameter :: fmt2 = &
537  "(A6,' E(',i1,',',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
538  character(len=*),parameter :: fmt3 = &
539  "(A6,' E*T(',i1,',',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
540  character(len=*),parameter :: fmt4 = &
541  "(A6,' E(',i1,',',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
542 
543 ! data DiffCntE /0/
544 
545  checkcnt_cll(5) = checkcnt_cll(5) + 1
546 
547  flagec=1
548  if(diffcntec_cll.ge.maxcheckec_cll) flagec=0
549  if(ncheckout_cll.eq.closed_cll) flagec=0
550  ratio=0d0
551 
552  if(.false.) then ! E-tensor coefficients are not unique!
553  ediff=0d0
554  do r=0,rmax
555  do n0=0,r/2
556  do n1=0,r-2*n0
557  do n2=0,r-2*n0-n1
558  do n3=0,r-2*n0-n1-n2
559  n4 = r-2*n0-n1-n2-n3
560 ! norm = min(abs(E(n0,n1,n2,n3,n4)),abs(E2(n0,n1,n2,n3,n4)))
561  norm = norm0/norm0**(n0/3d0)
562  diffe = e(n0,n1,n2,n3,n4)-e2(n0,n1,n2,n3,n4)
563  if (n0.eq.0) ediff(r)=max(ediff(r),abs(diffe))
564  if ((abs(diffe).gt.checkacc_cll*norm).and.(flagec.eq.1)) then
565  write(ncheckout_cll,*) '*************************************************************************'
566  write(ncheckout_cll,*) 'E difference NO.', diffcntec_cll+1
567  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
568  write(ncheckout_cll,'(A21,I2,A4,I2)') 'E integral with rank', r,' of ',rmax
569 ! write(ncheckout_cll,*) '------------------------------------------------------------------------'
570 ! write(ncheckout_cll,*) 'n0', n0
571 ! write(ncheckout_cll,*) 'n1', n1
572 ! write(ncheckout_cll,*) 'n2', n2
573 ! write(ncheckout_cll,*) 'n3', n3
574 ! write(ncheckout_cll,*) 'n4', n4
575  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
576  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
577  write(ncheckout_cll,*) 'mode ', mode_cll
578  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
579  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
580  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
581  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
582  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
583  write(ncheckout_cll,*) 'nminf ', nminf_cll
584  do i=1,nminf_cll
585  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
586  end do
587  write(ncheckout_cll,*) 'dprec ', dprec_cll
588  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
589  write(ncheckout_cll,*) 'critacc ', critacc_cll
590  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
591  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
592  write(ncheckout_cll,*) '------------------------------------------------------------'
593  write(ncheckout_cll,fmt1) 'p10=', p10
594  write(ncheckout_cll,fmt1) 'p21=', p21
595  write(ncheckout_cll,fmt1) 'p32=', p32
596  write(ncheckout_cll,fmt1) 'p43=', p43
597  write(ncheckout_cll,fmt1) 'p40=', p40
598  write(ncheckout_cll,fmt1) 'p20=', p20
599  write(ncheckout_cll,fmt1) 'p31=', p31
600  write(ncheckout_cll,fmt1) 'p42=', p42
601  write(ncheckout_cll,fmt1) 'p30=', p30
602  write(ncheckout_cll,fmt1) 'p41=', p41
603  write(ncheckout_cll,fmt1) 'm02=', m02
604  write(ncheckout_cll,fmt1) 'm12=', m12
605  write(ncheckout_cll,fmt1) 'm22=', m22
606  write(ncheckout_cll,fmt1) 'm32=', m32
607  write(ncheckout_cll,fmt1) 'm42=', m42
608  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
609  write(ncheckout_cll,fmt2) 'COLI:',0,0,0,0,0,e(0,0,0,0,0)
610  write(ncheckout_cll,fmt2) 'DD :',0,0,0,0,0,e2(0,0,0,0,0)
611  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,n4,e(n0,n1,n2,n3,n4)
612  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,n4,e2(n0,n1,n2,n3,n4)
613  write(ncheckout_cll,*) 'diff:', abs(diffe)/norm
614  flagec=2
615  ratio=abs(diffe)/norm
616  elseif((flagec.eq.2).and.(abs(diffe).gt.ratio*norm)) then
617  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,n4,e(n0,n1,n2,n3,n4)
618  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,n4,e2(n0,n1,n2,n3,n4)
619  write(ncheckout_cll,*) 'diff:', abs(diffe)/norm
620  ratio=abs(diffe)/norm
621  elseif ((abs(diffe).gt.checkacc_cll*norm).and.(flagec.eq.0)) then
622  flagec=3
623  end if
624  end do
625  end do
626  end do
627  end do
628  end do
629  if((flagec.eq.2))then
630  write(ncheckout_cll,*) '*************************************************************************'
631  write(ncheckout_cll,*) ' end Ec'
632  write(ncheckout_cll,*)
633  diffcntec_cll = diffcntec_cll + 1
634  if(diffcntec_cll.eq.maxcheckec_cll) then
635  write(ncheckout_cll,*) ' Further output for differences Ec in E functions suppressed '
636  write(ncheckout_cll,*)
637  endif
638  elseif(flagec.eq.3)then
639  diffcntec_cll = diffcntec_cll + 1
640  endif
641 
642  end if
643 
644  flag=1
645  if(diffcnt_cll(5).ge.maxcheck_cll(5)) flag=0
646  if(ncheckout_cll.eq.closed_cll) flag=0
647  ratio=0d0
648 
649  gram(1,1) = p10
650  gram(2,2) = p20
651  gram(3,3) = p30
652  gram(4,4) = p40
653  gram(1,2) = (p10+p20-p21)*.5d0
654  gram(1,3) = (p10+p30-p31)*.5d0
655  gram(1,4) = (p10+p40-p41)*.5d0
656  gram(2,3) = (p20+p30-p32)*.5d0
657  gram(2,4) = (p20+p40-p42)*.5d0
658  gram(3,4) = (p30+p40-p43)*.5d0
659  gram(2,1) = gram(1,2)
660  gram(3,1) = gram(1,3)
661  gram(4,1) = gram(1,4)
662  gram(3,2) = gram(2,3)
663  gram(4,2) = gram(2,4)
664  gram(4,3) = gram(3,4)
665  !Zmax = maxval(abs(Gram(1:4,1:4)))
666 
667  locons = lostrucconts(4,rmax,gram)
668 
669  ediff=0d0
670  do r=0,rmax
671  do m0=0,r/2
672  struc1(:,0)=m0
673  norm = norm0/norm0**((r-m0)/3d0)
674  ! norm = Zmax**(r-m0)*norm0*max(1d0,1d0/(norm0**(1d0/3d0)*Zmax))**(r/2) to large !!
675  ! norm = Zmax**(r-m0)*norm0*(1d0/(norm0**(1d0/3d0)*Zmax))**(r/2)
676  do i1=1,binomtable(r-2*m0,3+r-2*m0)
677  struc1(i1,1:4)=calccindarr(4,r-2*m0,i1)
678  ep(i1) =0d0
679  ep2(i1)=0d0
680  do n0=0,r/2
681  struc2(0)=n0
682  do i2=1,binomtable(r-2*n0,3+r-2*n0)
683  struc2(1:4)=calccindarr(4,r-2*n0,i2)
684  ep(i1) = ep(i1) &
685  + e(n0,struc2(1),struc2(2),struc2(3),struc2(4))* &
686  locons(m0,i1,n0,i2,r)
687  ep2(i1) = ep2(i1) &
688  + e2(n0,struc2(1),struc2(2),struc2(3),struc2(4))* &
689  locons(m0,i1,n0,i2,r)
690  enddo
691  enddo
692 
693  norm = max(norm,min(abs(ep(i1)),abs(ep2(i1))))
694  diffep(i1) = ep(i1)-ep2(i1)
695  enddo
696 
697  do i1=1,binomtable(r-2*m0,3+r-2*m0)
698  ediff(r) = max(ediff(r),abs(diffep(i1))/norm)
699 
700  if ((abs(diffep(i1)).gt.checkacc_cll*norm).and.(flag.eq.1)) then
701  write(ncheckout_cll,*) '*************************************************************************'
702  write(ncheckout_cll,*) 'E difference NO.', diffcnt_cll(5)+1
703  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
704  write(ncheckout_cll,'(A21,I2,A4,I2)') 'E integral with rank', r,' of ',rmax
705  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
706  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
707  write(ncheckout_cll,*) 'mode ', mode_cll
708  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
709  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
710  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
711  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
712  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
713  write(ncheckout_cll,*) 'nminf ', nminf_cll
714  do i=1,nminf_cll
715  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
716  end do
717  write(ncheckout_cll,*) 'dprec ', dprec_cll
718  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
719  write(ncheckout_cll,*) 'critacc ', critacc_cll
720  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
721  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
722  write(ncheckout_cll,*) '------------------------------------------------------------'
723  write(ncheckout_cll,fmt1) 'p10=', p10
724  write(ncheckout_cll,fmt1) 'p21=', p21
725  write(ncheckout_cll,fmt1) 'p32=', p32
726  write(ncheckout_cll,fmt1) 'p43=', p43
727  write(ncheckout_cll,fmt1) 'p40=', p40
728  write(ncheckout_cll,fmt1) 'p20=', p20
729  write(ncheckout_cll,fmt1) 'p31=', p31
730  write(ncheckout_cll,fmt1) 'p42=', p42
731  write(ncheckout_cll,fmt1) 'p30=', p30
732  write(ncheckout_cll,fmt1) 'p41=', p41
733  write(ncheckout_cll,fmt1) 'm02=', m02
734  write(ncheckout_cll,fmt1) 'm12=', m12
735  write(ncheckout_cll,fmt1) 'm22=', m22
736  write(ncheckout_cll,fmt1) 'm32=', m32
737  write(ncheckout_cll,fmt1) 'm42=', m42
738  write(ncheckout_cll,*) '--------------------------------------------------------------------------'
739  write(ncheckout_cll,fmt4) 'COLI:',0,0,0,0,0,e(0,0,0,0,0)
740  write(ncheckout_cll,fmt4) 'DD :',0,0,0,0,0,e2(0,0,0,0,0)
741  write(ncheckout_cll,fmt3) 'COLI:',struc1(i1,0:4),ep(i1)
742  write(ncheckout_cll,fmt3) 'DD :',struc1(i1,0:4),ep2(i1)
743  write(ncheckout_cll,*) 'diff :', abs(diffep(i1))/norm
744 ! write(ncheckout_cll,*) 'adiff:', abs(diffEp(i1))
745 ! write(ncheckout_cll,*) 'norm :', norm
746 ! write(ncheckout_cll,*) 'normo:', norm0/norm0**((r-m0)/3d0)
747 ! write(ncheckout_cll,*) 'normn:', Zmax**(r-m0)*norm0*(1d0/(norm0**(1d0/3d0)*Zmax))**(r/2)
748 ! write(ncheckout_cll,*) 'norml:', Zmax**(r-m0)*norm0*max(1d0,(1d0/(norm0**(1d0/3d0)*Zmax))**(r/2))
749 ! write(ncheckout_cll,*) 'norm0:', norm0
750 ! write(ncheckout_cll,*) 'Zmax:', Zmax
751  flag=2
752  ratio=abs(diffep(i1))/norm
753  elseif((flag.eq.2).and.(abs(diffep(i1)).gt.ratio*norm)) then
754 ! elseif((flag.eq.2).and.(abs(diffEp(i1)).gt.checkacc_cll*norm)) then
755  write(ncheckout_cll,fmt3) 'COLI:',struc1(i1,0:4),ep(i1)
756  write(ncheckout_cll,fmt3) 'DD :',struc1(i1,0:4),ep2(i1)
757  write(ncheckout_cll,*) 'diff:', abs(diffep(i1))/norm
758  ratio=abs(diffep(i1))/norm
759  elseif ((abs(diffep(i1)).gt.checkacc_cll*norm).and.(flag.eq.0)) then
760  flag=3
761  end if
762  end do
763  end do
764  end do
765  ediff=ediff*norm0
766 
767  if((flag.eq.2))then
768  write(ncheckout_cll,*) '*************************************************************************'
769  write(ncheckout_cll,*) ' end E'
770  write(ncheckout_cll,*)
771  diffcnt_cll(5) = diffcnt_cll(5) + 1
772  if(diffcnt_cll(5).eq.maxcheck_cll(5)) then
773  write(ncheckout_cll,*) ' Further output for differences in E functions suppressed '
774  write(ncheckout_cll,*)
775  endif
776  elseif(flag.eq.3)then
777  diffcnt_cll(5) = diffcnt_cll(5) + 1
778  endif
779 
780 

◆ checkcoefsf_cll()

subroutine collier_aux::checkcoefsf_cll ( double complex, dimension(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax), intent(in)  F,
double complex, dimension(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax), intent(in)  F2,
double complex, intent(in)  p10,
double complex, intent(in)  p21,
double complex, intent(in)  p32,
double complex, intent(in)  p43,
double complex, intent(in)  p54,
double complex, intent(in)  p50,
double complex, intent(in)  p20,
double complex, intent(in)  p31,
double complex, intent(in)  p42,
double complex, intent(in)  p53,
double complex, intent(in)  p40,
double complex, intent(in)  p51,
double complex, intent(in)  p30,
double complex, intent(in)  p41,
double complex, intent(in)  p52,
double complex, intent(in)  m02,
double complex, intent(in)  m12,
double complex, intent(in)  m22,
double complex, intent(in)  m32,
double complex, intent(in)  m42,
double complex, intent(in)  m52,
integer, intent(in)  rmax,
double precision, intent(in)  norm0,
double precision, dimension(0:rmax), intent(out)  Fdiff 
)

Definition at line 795 of file collier_aux.F90.

795 
796  integer, intent(in) :: rmax
797  double complex, intent(in) :: p10,p21,p32,p43,p54,p50,p20,p31,p42,p53,p40
798  double complex, intent(in) :: p51,p30,p41,p52,m02,m12,m22,m32,m42,m52
799  double complex, intent(in) :: F(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
800  double complex, intent(in) :: F2(0:rmax/2,0:rmax,0:rmax,0:rmax,0:rmax,0:rmax)
801  double precision, intent(in) :: norm0
802  double precision, intent(out) :: Fdiff(0:rmax)
803  double complex :: diffF,Gram(5,5)
804  double complex :: Fp(BinomTable(rmax,rmax+4)),Fp2(BinomTable(rmax,rmax+4)),diffFp(BinomTable(rmax,rmax+4))
805 ! double precision :: norm,ratio,Zmax
806  double precision :: norm,ratio
807  integer :: r,n0,n1,n2,n3,n4,n5,m0,m1,m2,m3,m4,m5,i,flag,flag2
808  integer :: struc1(BinomTable(rmax,rmax+4),0:5), struc2(0:5)
809 ! integer, parameter :: noutCheckFmax=50
810 ! integer, save :: DiffCntF
811 
812  double complex :: LoCons(0:rmax/2,BinomTable(rmax,rmax+4),0:rmax/2,BinomTable(rmax,rmax+4),0:rmax)
813  integer :: i1,i2
814 
815  character(len=*),parameter :: fmt1 = "(A5,'dcmplx(',d25.18,',',d25.18,' )')"
816  character(len=*),parameter :: fmt2 = &
817  "(A6,' F(',i1,',',i1,',',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
818  character(len=*),parameter :: fmt3 = &
819  "(A6,' F*T(',i1,',',i1,',',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
820  character(len=*),parameter :: fmt4 = &
821  "(A6,' F(',i1,',',i1,',',i1,',',i1,',',i1,',',i1,') = (',E23.16,' , ',E23.16,' )')"
822 
823 ! data DiffCntF /0/
824 
825  checkcnt_cll(6) = checkcnt_cll(6) + 1
826 
827  flag2=1
828  if(diffcnt_cll(6).ge.maxcheck_cll(6)) flag2=0
829  if(ncheckout_cll.eq.closed_cll) flag2=0
830 
831  if(.false.)then ! tensor F coefficients are not unique
832  ratio=0d0
833 
834  fdiff=0d0
835  do r=0,rmax
836  do n0=0,r/2
837  do n1=0,r-2*n0
838  do n2=0,r-2*n0-n1
839  do n3=0,r-2*n0-n1-n2
840  do n4=0,r-2*n0-n1-n2-n3
841  n5 = r-2*n0-n1-n2-n3-n4
842 ! norm = min(abs(F(n0,n1,n2,n3,n4,n5)),abs(F2(n0,n1,n2,n3,n4,n5)))
843  norm = norm0/norm0**(n0/4d0)
844  difff = f(n0,n1,n2,n3,n4,n5)-f2(n0,n1,n2,n3,n4,n5)
845  if (n0.eq.0) fdiff(r) = max(fdiff(r),abs(difff))
846  if ((abs(difff).gt.checkacc_cll*norm).and.(flag2.eq.1)) then
847  write(ncheckout_cll,*) '*************************************************************************'
848  write(ncheckout_cll,*) 'F difference NO.', diffcnt_cll(6)+1
849  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
850  write(ncheckout_cll,'(A21,I2,A4,I2)') 'F integral with rank', r,' of ',rmax
851 ! write(ncheckout_cll,*) '-------------------------------------------------------------------------'
852 ! write(ncheckout_cll,*) 'n0', n0
853 ! write(ncheckout_cll,*) 'n1', n1
854 ! write(ncheckout_cll,*) 'n2', n2
855 ! write(ncheckout_cll,*) 'n3', n3
856 ! write(ncheckout_cll,*) 'n4', n4
857 ! write(ncheckout_cll,*) 'n5', n5
858  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
859  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
860  write(ncheckout_cll,*) 'mode ', mode_cll
861  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
862  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
863  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
864  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
865  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
866  write(ncheckout_cll,*) 'nminf ', nminf_cll
867  do i=1,nminf_cll
868  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
869  end do
870  write(ncheckout_cll,*) 'dprec ', dprec_cll
871  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
872  write(ncheckout_cll,*) 'critacc ', critacc_cll
873  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
874  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
875  write(ncheckout_cll,*) '------------------------------------------------------------'
876  write(ncheckout_cll,fmt1) 'p10=', p10
877  write(ncheckout_cll,fmt1) 'p21=', p21
878  write(ncheckout_cll,fmt1) 'p32=', p32
879  write(ncheckout_cll,fmt1) 'p43=', p43
880  write(ncheckout_cll,fmt1) 'p54=', p54
881  write(ncheckout_cll,fmt1) 'p50=', p50
882  write(ncheckout_cll,fmt1) 'p20=', p20
883  write(ncheckout_cll,fmt1) 'p31=', p31
884  write(ncheckout_cll,fmt1) 'p42=', p42
885  write(ncheckout_cll,fmt1) 'p53=', p53
886  write(ncheckout_cll,fmt1) 'p40=', p40
887  write(ncheckout_cll,fmt1) 'p51=', p51
888  write(ncheckout_cll,fmt1) 'p30=', p30
889  write(ncheckout_cll,fmt1) 'p41=', p41
890  write(ncheckout_cll,fmt1) 'p52=', p52
891  write(ncheckout_cll,fmt1) 'm02=', m02
892  write(ncheckout_cll,fmt1) 'm12=', m12
893  write(ncheckout_cll,fmt1) 'm22=', m22
894  write(ncheckout_cll,fmt1) 'm32=', m32
895  write(ncheckout_cll,fmt1) 'm42=', m42
896  write(ncheckout_cll,fmt1) 'm52=', m52
897  write(ncheckout_cll,*) '--------------------------------------------------------------------------'
898 ! write(ncheckout_cll,*) 'F0_coli:', F(0,0,0,0,0,0)
899 ! write(ncheckout_cll,*) 'F0_DD :', F2(0,0,0,0,0,0)
900  write(ncheckout_cll,fmt2) 'COLI:',0,0,0,0,0,0,f(0,0,0,0,0,0)
901  write(ncheckout_cll,fmt2) 'DD :',0,0,0,0,0,0,f2(0,0,0,0,0,0)
902  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,n4,n5,f(n0,n1,n2,n3,n4,n5)
903  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,n4,n5,f2(n0,n1,n2,n3,n4,n5)
904 ! write(ncheckout_cll,*) 'COLI:', F(n0,n1,n2,n3,n4,n5)
905 ! write(ncheckout_cll,*) 'DD :', F2(n0,n1,n2,n3,n4,n5)
906  write(ncheckout_cll,*) 'diff:', abs(difff)/norm
907  flag2=2
908  ratio=abs(difff)/norm
909  elseif((flag2.eq.2).and.(abs(difff).gt.ratio*norm)) then
910  write(ncheckout_cll,fmt2) 'COLI:',n0,n1,n2,n3,n4,n5,f(n0,n1,n2,n3,n4,n5)
911  write(ncheckout_cll,fmt2) 'DD :',n0,n1,n2,n3,n4,n5,f2(n0,n1,n2,n3,n4,n5)
912  write(ncheckout_cll,*) 'diff:', abs(difff)/norm
913  ratio=abs(difff)/norm
914  elseif ((abs(difff).gt.checkacc_cll*norm).and.(flag.eq.0)) then
915  flag=3
916  end if
917  end do
918  end do
919  end do
920  end do
921  end do
922  end do
923  end if
924 
925  flag=1
926  if(diffcnt_cll(6).ge.maxcheck_cll(6)) flag=0
927  if(ncheckout_cll.eq.closed_cll) flag=0
928  ratio=0d0
929 
930  gram(1,1) = p10
931  gram(2,2) = p20
932  gram(3,3) = p30
933  gram(4,4) = p40
934  gram(5,5) = p50
935  gram(1,2) = (p10+p20-p21)*.5d0
936  gram(1,3) = (p10+p30-p31)*.5d0
937  gram(1,4) = (p10+p40-p41)*.5d0
938  gram(1,5) = (p10+p50-p51)*.5d0
939  gram(2,3) = (p20+p30-p32)*.5d0
940  gram(2,4) = (p20+p40-p42)*.5d0
941  gram(2,5) = (p20+p50-p52)*.5d0
942  gram(3,4) = (p30+p40-p43)*.5d0
943  gram(3,5) = (p30+p50-p53)*.5d0
944  gram(4,5) = (p40+p50-p54)*.5d0
945  gram(2,1) = gram(1,2)
946  gram(3,1) = gram(1,3)
947  gram(4,1) = gram(1,4)
948  gram(5,1) = gram(1,5)
949  gram(3,2) = gram(2,3)
950  gram(4,2) = gram(2,4)
951  gram(5,2) = gram(2,5)
952  gram(4,3) = gram(3,4)
953  gram(5,3) = gram(3,5)
954  gram(5,4) = gram(4,5)
955 ! Zmax=maxval(abs(Gram(1:5,1:5)))
956 
957  locons = lostrucconts(5,rmax,gram)
958 
959  fdiff=0d0
960  do r=0,rmax
961  do m0=0,r/2
962  struc1(:,0)=m0
963  norm = norm0/norm0**((r-m0)/4d0)
964  ! norm = Zmax**(r-m0)*norm0*max(1d0,1d0/(norm0**(1d0/4d0)*Zmax))**(r/2) too large
965  ! norm = Zmax**(r-m0)*norm0*(1d0/(norm0**(1d0/4d0)*Zmax))**(r/2)
966  do i1=1,binomtable(r-2*m0,4+r-2*m0)
967  struc1(i1,1:5)=calccindarr(5,r-2*m0,i1)
968  fp(i1) =0d0
969  fp2(i1)=0d0
970  do n0=0,r/2
971  struc2(0)=n0
972  do i2=1,binomtable(r-2*n0,4+r-2*n0)
973  struc2(1:5)=calccindarr(5,r-2*n0,i2)
974  fp(i1) = fp(i1) &
975  + f(n0,struc2(1),struc2(2),struc2(3),struc2(4),struc2(5))* &
976  locons(m0,i1,n0,i2,r)
977  fp2(i1) = fp2(i1) &
978  + f2(n0,struc2(1),struc2(2),struc2(3),struc2(4),struc2(5))* &
979  locons(m0,i1,n0,i2,r)
980  enddo
981  enddo
982 
983  norm = max(norm,min(abs(fp(i1)),abs(fp2(i1))))
984  difffp(i1) = fp(i1)-fp2(i1)
985  enddo
986 
987  do i1=1,binomtable(r-2*m0,4+r-2*m0)
988  fdiff(r) = max(fdiff(r),abs(difffp(i1))/norm)
989 
990  if ((abs(difffp(i1)).gt.checkacc_cll*norm).and.(flag.eq.1)) then
991  write(ncheckout_cll,*) '*************************************************************************'
992  write(ncheckout_cll,*) 'F difference NO.', diffcnt_cll(6)+1
993  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
994  write(ncheckout_cll,'(A21,I2,A4,I2)') 'F integral with rank', r,' of ',rmax
995  write(ncheckout_cll,*) '-------------------------------------------------------------------------'
996  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
997  write(ncheckout_cll,*) 'mode ', mode_cll
998  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
999  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
1000  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
1001  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
1002  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
1003  write(ncheckout_cll,*) 'nminf ', nminf_cll
1004  do i=1,nminf_cll
1005  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
1006  end do
1007  write(ncheckout_cll,*) 'dprec ', dprec_cll
1008  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
1009  write(ncheckout_cll,*) 'critacc ', critacc_cll
1010  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
1011  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
1012  write(ncheckout_cll,*) '------------------------------------------------------------'
1013  write(ncheckout_cll,fmt1) 'p10=', p10
1014  write(ncheckout_cll,fmt1) 'p21=', p21
1015  write(ncheckout_cll,fmt1) 'p32=', p32
1016  write(ncheckout_cll,fmt1) 'p43=', p43
1017  write(ncheckout_cll,fmt1) 'p54=', p54
1018  write(ncheckout_cll,fmt1) 'p50=', p50
1019  write(ncheckout_cll,fmt1) 'p20=', p20
1020  write(ncheckout_cll,fmt1) 'p31=', p31
1021  write(ncheckout_cll,fmt1) 'p42=', p42
1022  write(ncheckout_cll,fmt1) 'p53=', p53
1023  write(ncheckout_cll,fmt1) 'p40=', p40
1024  write(ncheckout_cll,fmt1) 'p51=', p51
1025  write(ncheckout_cll,fmt1) 'p30=', p30
1026  write(ncheckout_cll,fmt1) 'p41=', p41
1027  write(ncheckout_cll,fmt1) 'p52=', p52
1028  write(ncheckout_cll,fmt1) 'm02=', m02
1029  write(ncheckout_cll,fmt1) 'm12=', m12
1030  write(ncheckout_cll,fmt1) 'm22=', m22
1031  write(ncheckout_cll,fmt1) 'm32=', m32
1032  write(ncheckout_cll,fmt1) 'm42=', m42
1033  write(ncheckout_cll,fmt1) 'm52=', m52
1034  write(ncheckout_cll,*) '--------------------------------------------------------------------------'
1035  write(ncheckout_cll,fmt4) 'COLI:',0,0,0,0,0,0,f(0,0,0,0,0,0)
1036  write(ncheckout_cll,fmt4) 'DD :',0,0,0,0,0,0,f2(0,0,0,0,0,0)
1037  write(ncheckout_cll,fmt3) 'COLI:',struc1(i1,0:5),fp(i1)
1038  write(ncheckout_cll,fmt3) 'DD :',struc1(i1,0:5),fp2(i1)
1039  write(ncheckout_cll,*) 'diff:', abs(difffp(i1))/norm
1040 ! write(ncheckout_cll,*) 'adiff:', abs(diffFp(i1))
1041 ! write(ncheckout_cll,*) 'norm:', norm
1042 ! write(ncheckout_cll,*) 'normo:',norm0/norm0**((r-m0)/real(4))
1043 ! write(ncheckout_cll,*) 'normn:',Zmax**(r-m0)*norm0*(1d0/(norm0**(1d0/4d0)*Zmax))**(r/2)
1044 ! write(ncheckout_cll,*) 'norml:',Zmax**(r-m0)*norm0*max(1d0,1d0/(norm0**(1d0/4d0)*Zmax))**(r/2)
1045 ! write(ncheckout_cll,*) 'norm0:', norm0
1046 ! write(ncheckout_cll,*) 'Zmax:', Zmax
1047  flag=2
1048  ratio=abs(difffp(i1))/norm
1049  elseif((flag.eq.2).and.(abs(difffp(i1)).gt.ratio*norm)) then
1050 ! elseif((flag.eq.2).and.(abs(diffFp(i1)).gt.checkacc_cll*norm)) then
1051  write(ncheckout_cll,fmt3) 'COLI:',struc1(i1,0:5),fp(i1)
1052  write(ncheckout_cll,fmt3) 'DD :',struc1(i1,0:5),fp2(i1)
1053 ! write(ncheckout_cll,fmt3) 'COLI:',struc1(0),struc1(1),struc1(2), &
1054 ! struc1(3),struc1(4),struc1(5),Fp
1055 ! write(ncheckout_cll,fmt3) 'DD :',struc1(0),struc1(1),struc1(2), &
1056 ! struc1(3),struc1(4),struc1(5),Fp2
1057  write(ncheckout_cll,*) 'diff:', abs(difffp(i1))/norm
1058  ratio=abs(difffp(i1))/norm
1059  elseif ((abs(difffp(i1)).gt.checkacc_cll*norm).and.(flag.eq.0)) then
1060  flag=3
1061  end if
1062 
1063  end do
1064  end do
1065  end do
1066  fdiff = fdiff*norm0
1067 
1068  if(flag.eq.2)then
1069  write(ncheckout_cll,*) '***************************************************************************'
1070  write(ncheckout_cll,*) ' end F'
1071  write(ncheckout_cll,*)
1072  diffcnt_cll(6) = diffcnt_cll(6) + 1
1073  if(diffcnt_cll(6).eq.maxcheck_cll(6)) then
1074  write(ncheckout_cll,*) ' Further output for differences in F functions suppressed '
1075  write(ncheckout_cll,*)
1076  endif
1077  elseif(flag.eq.3)then
1078  diffcnt_cll(6) = diffcnt_cll(6) + 1
1079  endif
1080 
1081 

◆ checkcoefstn_cll()

subroutine collier_aux::checkcoefstn_cll ( double complex, dimension(ncoefs(rmax,n)), intent(in)  TN,
double complex, dimension(ncoefs(rmax,n)), intent(in)  TN2,
double complex, dimension(binomtable(2,n)), intent(in)  MomInv,
double complex, dimension(0:n-1), intent(in)  masses2,
integer, intent(in)  N,
integer, intent(in)  rmax,
double precision, intent(in)  norm0,
double precision, dimension(0:rmax), intent(out)  TNdiff 
)

Definition at line 1094 of file collier_aux.F90.

1094 
1095  integer, intent(in) :: N,rmax
1096  double complex, intent(in) :: MomInv(BinomTable(2,N)), masses2(0:N-1)
1097  double complex, intent(in) :: TN(NCoefs(rmax,N))
1098  double complex, intent(in) :: TN2(NCoefs(rmax,N))
1099  double precision, intent(in) :: norm0
1100  double precision, intent(out) :: TNdiff(0:rmax)
1101  double complex :: diffTN,Gram(N-1,N-1)
1102  double complex :: TNp(BinomTable(rmax,rmax+N-2)),TNp2(BinomTable(rmax,rmax+N-2)),diffTNp(BinomTable(rmax,rmax+N-2))
1103  double precision :: norm,ratio
1104 ! double precision :: norm,ratio,Zmax
1105  integer :: ind,i,m0,n0,ncnt,r,ncntr,flag,flag2
1106 ! integer, parameter :: noutCheckTNmax=50
1107 ! integer, save :: DiffCntTN
1108  double complex, allocatable :: LoCons(:,:,:,:,:)
1109  integer :: i1,i2
1110  character(len=*),parameter :: fmt1 = "(A8,'(',i2,')=dcmplx(',d25.18,',',d25.18,' )')"
1111  character(len=*),parameter :: fmt2 = &
1112  "(A6,' TN(',i2,') = (',E23.16,' , ',E23.16,' ), r=',i2)"
1113  character(len=*),parameter :: fmt3 = &
1114  "(A6,' TN*T(',i1,',',i2,') = (',E23.16,' , ',E23.16,' ), r=',i2)"
1115  character(len=*),parameter :: fmt4 = &
1116  "(A6,' TN(',i2,') = (',E23.16,' , ',E23.16,' )')"
1117 
1118 ! data DiffCntTN /0/
1119 
1120  checkcnt_cll(n) = checkcnt_cll(n) + 1
1121 
1122  flag=1
1123 
1124  if(diffcnt_cll(n).ge.maxcheck_cll(n)) flag=0
1125  if(ncheckout_cll.eq.closed_cll) flag=0
1126 
1127  ratio=0d0
1128 
1129  tndiff=0d0
1130  if (n.le.4) then
1131 ! r = 0
1132 ! do ind=1,NCoefs(rmax,N)
1133 ! if (ind.gt.NCoefs(r,N)) then
1134 ! r = r+1
1135 ! end if
1136 
1137  ncnt=0
1138  do r=0,rmax
1139  ncntr=ncnt
1140  do n0=r/2,0,-1
1141  do i2=1,binomtable(r-2*n0,n+r-2*n0-2)
1142  ncnt= ncnt + 1
1143  ind = ncnt
1144 
1145 ! norm = min(abs(TN(ind)),abs(TN2(ind)))
1146  if(n.ne.2) then
1147  norm = norm0/norm0**(n0/real(n-2))
1148  else
1149  if (max(abs(mominv(1)),abs(masses2(0)),abs(masses2(1))).ne.0d0) then
1150  norm = norm0*max(abs(mominv(1)),abs(masses2(0)),abs(masses2(1)))**n0
1151  else
1152  norm = norm0*muuv2_cll**n0
1153  end if
1154 
1155  endif
1156  difftn = tn(ind)-tn2(ind)
1157  if (n0.eq.0) tndiff(r) = max(tndiff(r),abs(difftn))
1158  if ((abs(difftn).gt.checkacc_cll*norm) .and.(flag.eq.1)) then
1159  write(ncheckout_cll,*) '***************************************************************************'
1160  write(ncheckout_cll,'(A12,I2,A16,I10)') 'TN with N =',n,' difference NO.', diffcnt_cll(n)+1
1161  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
1162  write(ncheckout_cll,'(A21,I2,A10,I2,A4,I2)') 'TN integral with N =', n, ' and rank ', r,' of ',rmax
1163  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
1164  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
1165  write(ncheckout_cll,*) 'mode ', mode_cll
1166  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
1167  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
1168  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
1169  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
1170  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
1171  write(ncheckout_cll,*) 'nminf ', nminf_cll
1172  do i=1,nminf_cll
1173  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
1174  end do
1175  write(ncheckout_cll,*) 'dprec ', dprec_cll
1176  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
1177  write(ncheckout_cll,*) 'critacc ', critacc_cll
1178  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
1179  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
1180  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
1181  do i=1,binomtable(2,n)
1182  write(ncheckout_cll,fmt1) 'MomInv ', i, mominv(i)
1183  end do
1184  do i=0,n-1
1185  write(ncheckout_cll,fmt1) 'masses2', i, masses2(i)
1186  end do
1187  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
1188  write(ncheckout_cll,fmt2) 'COLI:',1,tn(1),0
1189  write(ncheckout_cll,fmt2) 'DD :',1,tn2(1),0
1190  write(ncheckout_cll,fmt2) 'COLI:',ind,tn(ind),r
1191  write(ncheckout_cll,fmt2) 'DD :',ind,tn2(ind),r
1192 ! write(ncheckout_cll,*) 'COLI:', D(n0,n1,n2,n3)
1193 ! write(ncheckout_cll,*) 'DD :', D2(n0,n1,n2,n3)
1194  if(norm.ne.0d0)then
1195  write(ncheckout_cll,*) 'diff:', abs(difftn)/norm
1196  ratio=abs(difftn)/norm
1197  else
1198  write(ncheckout_cll,*) 'diff:', 1d50
1199  ratio=1d50
1200  endif
1201  flag=2
1202  elseif((flag.eq.2).and.(abs(difftn).gt.ratio*norm)) then
1203  write(ncheckout_cll,fmt2) 'COLI:',ind,tn(ind),r
1204  write(ncheckout_cll,fmt2) 'DD :',ind,tn2(ind),r
1205  if(norm.gt.1d-100)then
1206  write(ncheckout_cll,*) 'diff:', abs(difftn)/norm
1207  ratio=abs(difftn)/norm
1208  else
1209  write(ncheckout_cll,*) 'diff:', 1d50
1210  ratio=1d50
1211  endif
1212  elseif ((flag.eq.0).and.(abs(difftn).gt.checkacc_cll*norm)) then
1213  flag=3
1214  end if
1215 
1216  end do
1217  end do
1218 
1219  end do
1220 
1221  else
1222 
1223  gram = calcgram(n,mominv)
1224 ! Zmax = maxval(abs(Gram(1:N-1,1:N-1)))
1225  allocate(locons(0:rmax/2,binomtable(rmax,rmax+n-2),0:rmax/2,binomtable(rmax,rmax+n-2),0:rmax))
1226  locons = lostrucconts(n-1,rmax,gram)
1227 
1228  ncnt=0
1229  do r=0,rmax
1230  ncntr=ncnt
1231  do m0=r/2,0,-1
1232  if (r-m0.ne.0) then
1233  norm = norm0/norm0**((r-m0)/real(n-2))
1234  ! norm = Zmax**(r-m0)*norm0*(1d0/(norm0**(1d0/real(N-2))*Zmax))**(r/2)
1235  else
1236  norm = norm0
1237  ! norm = norm0*(1d0/(norm0**(1d0/real(N-2))*Zmax))**(r/2)
1238  end if
1239  do i1=1,binomtable(r-2*m0,n+r-2*m0-2)
1240  tnp(i1) =0d0
1241  tnp2(i1)=0d0
1242  ncnt = ncntr
1243  do n0=r/2,0,-1
1244  do i2=1,binomtable(r-2*n0,n+r-2*n0-2)
1245  ncnt= ncnt + 1
1246  tnp(i1) = tnp(i1) + tn(ncnt)*locons(m0,i1,n0,i2,r)
1247  tnp2(i1) = tnp2(i1) + tn2(ncnt)*locons(m0,i1,n0,i2,r)
1248  end do
1249  end do
1250  norm = max(norm,min(abs(tnp(i1)),abs(tnp2(i1))))
1251  difftnp(i1) = tnp(i1)-tnp2(i1)
1252  enddo
1253 
1254  do i1=1,binomtable(r-2*m0,n+r-2*m0-2)
1255  tndiff(r) = max(tndiff(r),abs(difftnp(i1))/norm)
1256 
1257  if ((abs(difftnp(i1)).gt.checkacc_cll*norm).and.(flag.eq.1)) then
1258  write(ncheckout_cll,*) '***************************************************************************'
1259  write(ncheckout_cll,'(A12,I2,A16,I10)') 'TN with N =',n,' difference NO.', diffcnt_cll(n)+1
1260  write(ncheckout_cll,*) 'COLI and DD do not agree! checkacc =', checkacc_cll
1261  write(ncheckout_cll,'(A21,I2,A10,I2,A4,I2)') 'TN integral with N =', n, ' and rank ', r, ' of ',rmax
1262  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
1263  write(ncheckout_cll,*) 'GLOBAL PARAMETERS:'
1264  write(ncheckout_cll,*) 'mode ', mode_cll
1265  write(ncheckout_cll,*) 'muUV2 ', muuv2_cll
1266  write(ncheckout_cll,*) 'muIR2 ', muir2_cll
1267  write(ncheckout_cll,*) 'deltaUV ', deltauv_cll
1268  write(ncheckout_cll,*) 'deltaIR1 ', deltair1_cll
1269  write(ncheckout_cll,*) 'deltaIR2 ', deltair2_cll
1270  write(ncheckout_cll,*) 'nminf ', nminf_cll
1271  do i=1,nminf_cll
1272  write(ncheckout_cll,*) 'minf2 ', i, minf2_cll(i)
1273  end do
1274  write(ncheckout_cll,*) 'dprec ', dprec_cll
1275  write(ncheckout_cll,*) 'reqacc ', reqacc_cll
1276  write(ncheckout_cll,*) 'critacc ', critacc_cll
1277  write(ncheckout_cll,*) 'checkacc ', checkacc_cll
1278  write(ncheckout_cll,*) 'ErrFlag ', errflag_cll
1279  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
1280  do i=1,binomtable(2,n)
1281  write(ncheckout_cll,fmt1) 'MomInv', i, mominv(i)
1282  end do
1283  do i=0,n-1
1284  write(ncheckout_cll,fmt1) 'masses2', i, masses2(i)
1285  end do
1286  write(ncheckout_cll,*) '---------------------------------------------------------------------------'
1287  write(ncheckout_cll,fmt2) 'COLI:',1,tn(1),0
1288  write(ncheckout_cll,fmt2) 'DD :',1,tn2(1),0
1289  write(ncheckout_cll,fmt3) 'COLI:',m0,i1,tnp(i1),r
1290  write(ncheckout_cll,fmt3) 'DD :',m0,i1,tnp2(i1),r
1291  write(ncheckout_cll,*) 'diff:', abs(difftnp(i1))/norm
1292 ! write(ncheckout_cll,*) 'norm:', norm
1293 ! write(ncheckout_cll,*) 'normo:',norm0/norm0**((r-m0)/real(N-2))
1294 ! write(ncheckout_cll,*) 'norm0:', norm0
1295 ! write(ncheckout_cll,*) 'Zmax:', Zmax
1296  flag=2
1297  ratio=abs(difftnp(i1))/norm
1298  elseif((flag.eq.2).and.(abs(difftnp(i1)).gt.ratio*norm)) then
1299 ! elseif((flag.eq.2).and.(abs(diffTN(i1)).gt.checkacc_cll*norm)) then
1300  write(ncheckout_cll,fmt3) 'COLI:',m0,i1,tnp(i1),r
1301  write(ncheckout_cll,fmt3) 'DD :',m0,i1,tnp2(i1),r
1302  write(ncheckout_cll,*) 'diff:', abs(difftnp(i1))/norm
1303  ratio=abs(difftnp(i1))/norm
1304  elseif ((flag.eq.0).and.(abs(difftnp(i1)).gt.checkacc_cll*norm)) then
1305  flag=3
1306  end if
1307 
1308  end do
1309  end do
1310  end do
1311  tndiff = tndiff*norm0
1312  end if
1313 
1314  if(flag.eq.2)then
1315  write(ncheckout_cll,*) '*************************************************************************'
1316  write(ncheckout_cll,*) ' end TN '
1317  write(ncheckout_cll,*)
1318  diffcnt_cll(n) = diffcnt_cll(n) + 1
1319  if(diffcnt_cll(n).eq.maxcheck_cll(n)) then
1320  write(ncheckout_cll,*) ' Further output for differences in TN functions suppressed '
1321  write(ncheckout_cll,*)
1322  endif
1323  else if (flag.eq.3) then
1324  diffcnt_cll(n) = diffcnt_cll(n) + 1
1325  endif
1326 
1327 

◆ contractlostruc()

recursive double complex function collier_aux::contractlostruc ( integer, intent(in)  Nm1,
integer, dimension(0:nm1), intent(in)  struc1,
integer, dimension(0:nm1), intent(in)  struc2,
double complex, dimension(nm1,nm1), intent(in)  Gram 
)

Definition at line 2495 of file collier_aux.F90.

2495 
2496  integer, intent(in) :: Nm1
2497  integer, intent(in) :: struc1(0:Nm1), Struc2(0:Nm1)
2498  integer :: struc1aux(0:Nm1), struc2aux(0:Nm1), struc2aux2(0:Nm1)
2499  double complex, intent(in) :: Gram(Nm1,Nm1)
2500  double complex :: res
2501  integer :: i,j,con,sum1,sum2,fac
2502  logical :: errorwriteflag,eflag
2503 
2504  res = 0d0
2505 
2506  sum1 = 2*struc1(0)
2507  sum2 = 2*struc2(0)
2508  do i=1,nm1
2509  sum1 = sum1 + struc1(i)
2510  sum2 = sum2 + struc2(i)
2511  end do
2512 
2513  if (sum1.ne.sum2) then
2514  call seterrflag_coli(-10)
2515  call errout_cll('ContractLoStruc',' inconsistent call',eflag)
2516  if(eflag) then
2517  write(nerrout_cll,*) ' ContractLoStruc: Lorentz structures struc1 and struc2 must be of equal rank!'
2518  end if
2519  return
2520  end if
2521 
2522  if (sum1.eq.0) then
2523  res = 1d0
2524  return
2525  end if
2526 
2527  con = -1
2528  do i=0,nm1
2529  if (struc1(i).ge.1) then
2530  con = i
2531  end if
2532  end do
2533 
2534  struc1aux = struc1
2535  struc1aux(con) = struc1aux(con)-1
2536 
2537  if (con.ge.1) then
2538 
2539  ! contract p_con from T1 with g from T2
2540  if (struc2(0).ge.1) then
2541  struc2aux = struc2
2542  struc2aux(0) = struc2aux(0)-1
2543  struc2aux(con) = struc2aux(con)+1
2544  ! go on contracting recursively
2545  ! (factor struc2aux(con) because of symmetrization wrt. g and pi)
2546  res = res + struc2aux(con)*contractlostruc(nm1,struc1aux,struc2aux,gram)
2547  end if
2548 
2549  ! contract p_con from T1 with all the pi from T2
2550  do i=1,nm1
2551  if (struc2(i).ge.1) then
2552  struc2aux = struc2
2553  struc2aux(i) = struc2aux(i)-1
2554  ! go on contracting recursively
2555  res = res + gram(i,con)*contractlostruc(nm1,struc1aux,struc2aux,gram)
2556  end if
2557  end do
2558 
2559 
2560  else
2561 
2562  ! contract g from T1 with g from T2
2563  if (struc2(0).ge.1) then
2564  struc2aux = struc2
2565  struc2aux(0) = struc2aux(0)-1
2566  ! full contraction g^{mu,nu}.g_{mu,nu}
2567  ! tensor in D=4 dimensions g*g=4
2568  fac = 4
2569  do i=0,nm1
2570  ! partial contration g^{mu,nu}.(pi_mu g_{nu,rho})
2571  ! or g^{mu,nu}.(g_{mu,rho}g_{nu,sigma})
2572  ! factor 2 for mu <--> nu
2573  fac = fac + 2*struc2aux(i)
2574  end do
2575  ! go on contracting recursively
2576  res = res + fac*contractlostruc(nm1,struc1aux,struc2aux,gram)
2577  end if
2578 
2579  ! contract g^{mu,nu} from T1 with pi,pj from T2
2580  do i=1,nm1
2581  if (struc2(i).ge.1) then
2582  struc2aux = struc2
2583  struc2aux(i) = struc2aux(i)-1
2584  do j=1,nm1
2585  if (struc2aux(j).ge.1) then
2586  struc2aux2 = struc2aux
2587  struc2aux2(j) = struc2aux2(j)-1
2588  ! go on contracting recursively
2589  res = res + gram(i,j)*contractlostruc(nm1,struc1aux,struc2aux2,gram)
2590  end if
2591  end do
2592  end if
2593  end do
2594 
2595  end if
2596 
2597 

◆ critpointsout2_cll()

subroutine collier_aux::critpointsout2_cll ( character(len=*), intent(in)  sub,
integer, intent(in)  N,
double precision, intent(in)  acc,
integer  cntr 
)

Definition at line 1650 of file collier_aux.F90.

1650 
1651  character(len=*), intent(in) :: sub
1652  double precision, intent(in) :: acc
1653  integer, intent(in) :: N
1654  integer :: i,cntr
1655 
1656  write(ncpout2_cll,*)
1657  write(ncpout2_cll,*)
1658  write(ncpout2_cll,*)
1659  write(ncpout2_cll,*) '***********************************************************'
1660  write(ncpout2_cll,'(A19,I6)') 'Critical Point NO.', cntr
1661  if (n.gt.0) then
1662  write(ncpout2_cll,'(A14,A9,A5,I2)') &
1663  'in integral: ', trim(sub),', N = ',n
1664  else
1665  write(ncpout2_cll,*) 'in integral: ', trim(sub)
1666  endif
1667  write(ncpout2_cll,*) 'estimated accuracy: ', acc
1668  write(ncpout2_cll,*) '-----------------------------------------------------------'
1669  write(ncpout2_cll,*) 'GLOBAL PARAMETERS:'
1670  write(ncpout2_cll,*) 'mode ', mode_cll
1671  write(ncpout2_cll,*) 'muUV2 ', muuv2_cll
1672  write(ncpout2_cll,*) 'muIR2 ', muir2_cll
1673  write(ncpout2_cll,*) 'deltaUV ', deltauv_cll
1674  write(ncpout2_cll,*) 'deltaIR1 ', deltair1_cll
1675  write(ncpout2_cll,*) 'deltaIR2 ', deltair2_cll
1676  write(ncpout2_cll,*) 'nminf ', nminf_cll
1677  do i=1,nminf_cll
1678  write(ncpout2_cll,*) 'minf2 ', i, minf2_cll(i)
1679  end do
1680  write(ncpout2_cll,*) 'dprec ', dprec_cll
1681  write(ncpout2_cll,*) 'reqacc ', reqacc_cll
1682  write(ncpout2_cll,*) 'critacc ', critacc_cll
1683  write(ncpout2_cll,*) 'checkacc ', checkacc_cll
1684  write(ncpout2_cll,*) 'ErrFlag ', errflag_cll
1685 ! write(ncpout2_cll,*) '------------------------------------------------------------'
1686  call writemaster_cll(ncpout2_cll)
1687 

◆ critpointsout_cll()

subroutine collier_aux::critpointsout_cll ( character(len=*), intent(in)  sub,
integer, intent(in)  N,
double precision, intent(in)  acc,
integer  cntr 
)

Definition at line 1602 of file collier_aux.F90.

1602 
1603  character(len=*), intent(in) :: sub
1604  double precision, intent(in) :: acc
1605  integer, intent(in) :: N
1606  integer :: i,cntr
1607 
1608  write(ncpout_cll,*)
1609  write(ncpout_cll,*)
1610  write(ncpout_cll,*)
1611  write(ncpout_cll,*) '***********************************************************'
1612  write(ncpout_cll,'(A19,I6)') 'Critical Point NO.', cntr
1613  if (n.gt.0) then
1614  write(ncpout_cll,'(A14,A9,A5,I2)') &
1615  'in integral: ', trim(sub),', N = ',n
1616  else
1617  write(ncpout_cll,*) 'in integral: ', trim(sub)
1618  endif
1619  write(ncpout_cll,*) 'estimated accuracy: ', acc
1620  write(ncpout_cll,*) '-----------------------------------------------------------'
1621  write(ncpout_cll,*) 'GLOBAL PARAMETERS:'
1622  write(ncpout_cll,*) 'mode ', mode_cll
1623  write(ncpout_cll,*) 'muUV2 ', muuv2_cll
1624  write(ncpout_cll,*) 'muIR2 ', muir2_cll
1625  write(ncpout_cll,*) 'deltaUV ', deltauv_cll
1626  write(ncpout_cll,*) 'deltaIR1 ', deltair1_cll
1627  write(ncpout_cll,*) 'deltaIR2 ', deltair2_cll
1628  write(ncpout_cll,*) 'nminf ', nminf_cll
1629  do i=1,nminf_cll
1630  write(ncpout_cll,*) 'minf2 ', i, minf2_cll(i)
1631  end do
1632  write(ncpout_cll,*) 'dprec ', dprec_cll
1633  write(ncpout_cll,*) 'reqacc ', reqacc_cll
1634  write(ncpout_cll,*) 'critacc ', critacc_cll
1635  write(ncpout_cll,*) 'checkacc ', checkacc_cll
1636  write(ncpout_cll,*) 'ErrFlag ', errflag_cll
1637 ! write(ncpout_cll,*) '------------------------------------------------------------'
1638  call writemaster_cll(ncpout_cll)
1639 

◆ errout_cll()

subroutine collier_aux::errout_cll ( character(len=*), intent(in)  sub,
character(len=*), intent(in)  err,
logical, intent(out)  flag,
logical, intent(in), optional  nomaster 
)

Definition at line 1555 of file collier_aux.F90.

1555 
1556  character(len=*), intent(in) :: sub, err
1557  logical, intent(out) :: flag
1558  logical, optional, intent(in) :: nomaster
1559 ! integer, parameter :: maxErrOut=100
1560 
1561  flag = .false.
1562  if (erroutlev_cll.eq.0) return
1563 
1564  errcnt_cll = errcnt_cll + 1
1565  if(nerrout_cll.ne.closed_cll) then
1566  if (errcnt_cll.le.maxerrout_cll) then
1567  write(nerrout_cll,*)
1568  write(nerrout_cll,*)
1569  write(nerrout_cll,*)
1570  write(nerrout_cll,*) '***********************************************************'
1571  write(nerrout_cll,*) 'ERROR NO.', errcnt_cll
1572  write(nerrout_cll,*) 'in routine: ', trim(sub)
1573  write(nerrout_cll,*) trim(err)
1574  flag=.true.
1575  if (present(nomaster)) then
1576  if(nomaster) return
1577  end if
1578  call writemaster_cll(nerrout_cll)
1579  elseif (errcnt_cll.eq.maxerrout_cll+1) then
1580  write(nerrout_cll,*)
1581  write(nerrout_cll,*)
1582  write(nerrout_cll,*)
1583  write(nerrout_cll,*) '***********************************************************'
1584  write(nerrout_cll,*)
1585  write(nerrout_cll,*) ' Further output of Errors will be suppressed '
1586  write(nerrout_cll,*)
1587  endif
1588  endif
1589 

◆ lostrucconts()

double complex function, dimension(0:rmax/2,binomtable(rmax,nm1+rmax-1),0:rmax/2,binomtable(rmax,nm1+rmax-1),0:rmax) collier_aux::lostrucconts ( integer, intent(in)  Nm1,
integer, intent(in)  rmax,
double complex, dimension(nm1,nm1), intent(in)  Gram 
)

Definition at line 2611 of file collier_aux.F90.

2611 
2612  integer, intent(in) :: Nm1,rmax
2613  double complex, intent(in) :: Gram(Nm1,Nm1)
2614  double complex :: LoCons(0:rmax/2,BinomTable(rmax,Nm1+rmax-1),0:rmax/2,BinomTable(rmax,Nm1+rmax-1),0:rmax)
2615  integer :: struc1(0:Nm1),struc2(0:Nm1),struc2aux(0:Nm1)
2616  integer :: r,i,j,i1,i2,i1aux,i2aux,i2aux2,n01,n02,con,fac,i20
2617 
2618 
2619  locons = 0d0
2620  locons(0,1,0,1,0) = 1d0
2621 
2622  do r=1,rmax
2623  do n01=0,r/2
2624  struc1(0) = n01
2625  do i1=1,binomtable(r-2*n01,nm1+r-2*n01-1)
2626  struc1(1:nm1) = calccindarr(nm1,r-2*n01,i1)
2627 
2628  con = -1
2629  do i=0,nm1
2630  if (struc1(i).ge.1) then
2631  con = i
2632  end if
2633  end do
2634 
2635  if (con.ge.1) then
2636  i1aux = dropcind2(con,i1,r-2*n01,nm1)
2637 
2638  do n02=0,r/2
2639  struc2(0) = n02
2640 
2641  do i2=1,binomtable(r-2*n02,nm1+r-2*n02-1)
2642  struc2(1:nm1) = calccindarr(nm1,r-2*n02,i2)
2643 
2644  ! contract p_con from T1 with g from T2
2645  if (struc2(0).ge.1) then
2646  ! (factor struc2(con)+1 because of symmetrization wrt. g and pi)
2647  i2aux = addtocind(con,i2,r-2*n02,nm1)
2648  locons(n01,i1,n02,i2,r) = locons(n01,i1,n02,i2,r) + &
2649  (struc2(con)+1)*locons(n01,i1aux,n02-1,i2aux,r-1)
2650  end if
2651 
2652  ! contract p_con from T1 with all the pi from T2
2653  do i=1,nm1
2654  if (struc2(i).ge.1) then
2655  i2aux = dropcind2(i,i2,r-2*n02,nm1)
2656  locons(n01,i1,n02,i2,r) = locons(n01,i1,n02,i2,r) + &
2657  gram(i,con)*locons(n01,i1aux,n02,i2aux,r-1)
2658  end if
2659  end do
2660 
2661  end do
2662  end do
2663 
2664  else
2665 
2666  do n02=0,r/2
2667  struc2(0) = n02
2668  do i2=1,binomtable(r-2*n02,nm1+r-2*n02-1)
2669  struc2(1:nm1) = calccindarr(nm1,r-2*n02,i2)
2670 
2671  ! contract g from T1 with g from T2
2672  if (struc2(0).ge.1) then
2673  ! full contraction g^{mu,nu}.g_{mu,nu}
2674  ! tensor in D=4 dimensions g*g=4
2675  fac = 2 ! =4-2 to compensate for addational +2 in subsequent loop
2676  do i=0,nm1
2677  ! partial contration g^{mu,nu}.(pi_mu g_{nu,rho})
2678  ! or g^{mu,nu}.(g_{mu,rho}g_{nu,sigma})
2679  ! factor 2 for mu <--> nu
2680  fac = fac + 2*struc2(i)
2681  end do
2682  locons(n01,i1,n02,i2,r) = locons(n01,i1,n02,i2,r) + &
2683  fac*locons(n01-1,i1,n02-1,i2,r-2)
2684  end if
2685 
2686  ! contract g^{mu,nu} from T1 with pi,pj from T2
2687  do i=1,nm1
2688  if (struc2(i).ge.1) then
2689  struc2aux = struc2
2690  struc2aux(i) = struc2aux(i)-1
2691  i2aux = dropcind2(i,i2,r-2*n02,nm1)
2692  do j=1,nm1
2693  if (struc2aux(j).ge.1) then
2694  i2aux2 = dropcind2(j,i2aux,r-2*n02,nm1)
2695  locons(n01,i1,n02,i2,r) = locons(n01,i1,n02,i2,r) + &
2696  gram(i,j)*locons(n01-1,i1,n02,i2aux2,r-2)
2697  end if
2698  end do
2699  end if
2700  end do
2701 
2702  end do
2703  end do
2704 
2705  end if
2706 
2707  end do
2708  end do
2709  end do
2710 

◆ printstatistics2_cll()

subroutine collier_aux::printstatistics2_cll

Definition at line 2253 of file collier_aux.F90.

2253 
2254  integer :: i
2255 
2256 101 format(' #calls ',a9,' = ',i20)
2257 102 format(' #calls ',a9,' (N = ',i1,') = ',i20)
2258 111 format(' #calls ',a9,' = ',i20,' or ',f10.5,' %')
2259 112 format(' #calls ',a9,' (N = ',i1,') = ',i20,' or ',f10.5,' %')
2260 
2261  if (.not.monitoring) then
2262  if (infoutlev_cll.ge.1) then
2263  write(ninfout_cll,*) 'COLLIER: CritPointsMonitor not initialized'
2264  write(ninfout_cll,*) ' no statistics available '
2265  end if
2266  return
2267  endif
2268 
2269  if(ncpout2_cll.eq.closed_cll) return
2270 
2271  write(ncpout2_cll,90)
2272 90 format (//' Collier: Summary of critical points:')
2273 
2274  write(ncpout2_cll,100)
2275 100 format (/' Total numbers of calls of COLLIER functions')
2276 
2277  if( pointscnta_cll.ne.0) then
2278  write(ncpout2_cll,101) 'A_cll',pointscnta_cll
2279  endif
2280  if( pointscntb_cll.ne.0) then
2281  write(ncpout2_cll,101) 'B_cll',pointscntb_cll
2282  endif
2283  if( pointscntc_cll.ne.0) then
2284  write(ncpout2_cll,101) 'C_cll',pointscntc_cll
2285  endif
2286  if( pointscntd_cll.ne.0) then
2287  write(ncpout2_cll,101) 'D_cll',pointscntd_cll
2288  endif
2289  if( pointscnte_cll.ne.0) then
2290  write(ncpout2_cll,101) 'E_cll',pointscnte_cll
2291  endif
2292  if( pointscntf_cll.ne.0) then
2293  write(ncpout2_cll,101) 'F_cll',pointscntf_cll
2294  endif
2295  if( pointscntg_cll.ne.0) then
2296  write(ncpout2_cll,101) 'G_cll',pointscntg_cll
2297  endif
2298  do i=1,nmax_cll
2299  if(pointscnttn_cll(i).ne.0) then
2300  write(ncpout2_cll,102) 'TN_cll',i,pointscnttn_cll(i)
2301  endif
2302  end do
2303 
2304  if( pointscntaten_cll.ne.0) then
2305  write(ncpout2_cll,101) 'Aten_cll',pointscntaten_cll
2306  endif
2307  if( pointscntbten_cll.ne.0) then
2308  write(ncpout2_cll,101) 'Bten_cll',pointscntbten_cll
2309  endif
2310  if( pointscntcten_cll.ne.0) then
2311  write(ncpout2_cll,101) 'Cten_cll',pointscntcten_cll
2312  endif
2313  if( pointscntdten_cll.ne.0) then
2314  write(ncpout2_cll,101) 'Dten_cll',pointscntdten_cll
2315  endif
2316  if( pointscnteten_cll.ne.0) then
2317  write(ncpout2_cll,101) 'Eten_cll',pointscnteten_cll
2318  endif
2319  if( pointscntften_cll.ne.0) then
2320  write(ncpout2_cll,101) 'Ften_cll',pointscntften_cll
2321  endif
2322  if( pointscntgten_cll.ne.0) then
2323  write(ncpout2_cll,101) 'Gten_cll',pointscntgten_cll
2324  endif
2325  do i=1,nmax_cll
2326  if(pointscnttnten_cll(i).ne.0) then
2327  write(ncpout2_cll,102) 'TNten_cll',i,pointscnttnten_cll(i)
2328  endif
2329  end do
2330 
2331  write(ncpout2_cll,110) reqacc_coli
2332 110 format (/' Numbers of calls of COLLIER functions'/ &
2333  ' with an estimated accuracy worse than reqacc_coli =',es11.4)
2334  if(pointscnta_cll.ne.0.and.accpointscnta_cll.ne.0) then
2335  write(ncpout2_cll,111) 'A_cll',accpointscnta2_cll,accpointscnta2_cll/real(pointscnta_cll)*1d2
2336  endif
2337  if(pointscntb_cll.ne.0.and.accpointscntb2_cll.ne.0) then
2338  write(ncpout2_cll,111) 'B_cll',accpointscntb2_cll,accpointscntb2_cll/real(pointscntb_cll)*1d2
2339  endif
2340  if(pointscntc_cll.ne.0.and.accpointscntc2_cll.ne.0) then
2341  write(ncpout2_cll,111) 'C_cll',accpointscntc2_cll,accpointscntc2_cll/real(pointscntc_cll)*1d2
2342  endif
2343  if(pointscntd_cll.ne.0.and.accpointscntd2_cll.ne.0) then
2344  write(ncpout2_cll,111) 'D_cll',accpointscntd2_cll,accpointscntd2_cll/real(pointscntd_cll)*1d2
2345  endif
2346  if(pointscnte_cll.ne.0.and.accpointscnte2_cll.ne.0) then
2347  write(ncpout2_cll,111) 'E_cll',accpointscnte2_cll,accpointscnte2_cll/real(pointscnte_cll)*1d2
2348  endif
2349  if(pointscntf_cll.ne.0.and.accpointscntf2_cll.ne.0) then
2350  write(ncpout2_cll,111) 'F_cll',accpointscntf2_cll,accpointscntf2_cll*1d2/pointscntf_cll
2351  endif
2352  if(pointscntg_cll.ne.0.and.accpointscntg2_cll.ne.0) then
2353  write(ncpout2_cll,111) 'G_cll',accpointscntg2_cll,accpointscntg2_cll*1d2/pointscntg_cll
2354  endif
2355  do i=1,nmax_cll
2356  if(pointscnttn_cll(i).ne.0.and.accpointscnttn2_cll(i).ne.0) then
2357  write(ncpout2_cll,112) 'TN_cll',i,accpointscnttn2_cll(i),accpointscnttn2_cll(i)*1d2/pointscnttn_cll(i)
2358  endif
2359  end do
2360 
2361  if(pointscntdbten_cll.ne.0.and.accpointscntdbten_cll.ne.0) then
2362  write(ncpout2_cll,111) 'DBten_cll',accpointscntdbten_cll,accpointscntdbten_cll/real(pointscntdbten_cll)*1d2
2363  endif
2364  if(pointscntaten_cll.ne.0.and.accpointscntaten_cll.ne.0) then
2365  write(ncpout2_cll,111) 'Aten_cll',accpointscntaten_cll,accpointscntaten_cll/real(pointscntaten_cll)*1d2
2366  endif
2367  if(pointscntbten_cll.ne.0.and.accpointscntbten_cll.ne.0) then
2368  write(ncpout2_cll,111) 'Bten_cll',accpointscntbten_cll,accpointscntbten_cll/real(pointscntbten_cll)*1d2
2369  endif
2370  if(pointscntcten_cll.ne.0.and.accpointscntcten_cll.ne.0) then
2371  write(ncpout2_cll,111) 'Cten_cll',accpointscntcten_cll,accpointscntcten_cll/real(pointscntcten_cll)*1d2
2372  endif
2373  if(pointscntdten_cll.ne.0.and.accpointscntdten_cll.ne.0) then
2374  write(ncpout2_cll,111) 'Dten_cll',accpointscntdten_cll,accpointscntdten_cll/real(pointscntdten_cll)*1d2
2375  endif
2376  if(pointscnteten_cll.ne.0.and.accpointscnteten_cll.ne.0) then
2377  write(ncpout2_cll,111) 'Eten_cll',accpointscnteten_cll,accpointscnteten_cll/real(pointscnteten_cll)*1d2
2378  endif
2379  if(pointscntften_cll.ne.0.and.accpointscntften_cll.ne.0) then
2380  write(ncpout2_cll,111) 'Ften_cll',accpointscntften_cll,accpointscntften_cll*1d2/pointscntften_cll
2381  endif
2382  if(pointscntgten_cll.ne.0.and.accpointscntgten_cll.ne.0) then
2383  write(ncpout2_cll,111) 'Gten_cll',accpointscntgten_cll,accpointscntgten_cll*1d2/pointscntgten_cll
2384  endif
2385  do i=1,nmax_cll
2386  if(pointscnttnten_cll(i).ne.0.and.accpointscnttnten_cll(i).ne.0) then
2387  write(ncpout2_cll,112) 'TNten_cll',i,accpointscnttnten_cll(i),accpointscnttnten_cll(i)*1d2/pointscnttnten_cll(i)
2388  endif
2389  end do
2390 
2391 ! write(ncpout2_cll,130) sqrt(reqacc_coli)
2392 130 format (/' Numbers of calls of COLLIER functions'/ &
2393  ' with an estimated accuracy worse than '/ &
2394  ' sqrt(reqacc_coli) =',es11.4)
2395 
2396 
2397  write(ncpout2_cll,120) critacc_cll
2398 120 format (/' Numbers of calls of COLLIER functions'/ &
2399  ' with an estimated accuracy worse than critacc_coli =',es11.4)
2400 
2401  if(pointscnta_cll.ne.0.and.critpointscnta_cll.ne.0) then
2402  write(ncpout2_cll,111) 'A_cll',critpointscnta_cll,critpointscnta_cll/real(pointscnta_cll)*1d2
2403  endif
2404  if(pointscntb_cll.ne.0.and.critpointscntb_cll.ne.0) then
2405  write(ncpout2_cll,111) 'B_cll',critpointscntb_cll,critpointscntb_cll/real(pointscntb_cll)*1d2
2406  endif
2407  if(pointscntc_cll.ne.0.and.critpointscntc2_cll.ne.0) then
2408  write(ncpout2_cll,111) 'C_cll',critpointscntc2_cll,critpointscntc2_cll/real(pointscntc_cll)*1d2
2409  endif
2410  if(pointscntd_cll.ne.0.and.critpointscntd2_cll.ne.0) then
2411  write(ncpout2_cll,111) 'D_cll',critpointscntd2_cll,critpointscntd2_cll/real(pointscntd_cll)*1d2
2412  endif
2413  if(pointscnte_cll.ne.0.and.critpointscnte2_cll.ne.0) then
2414  write(ncpout2_cll,111) 'E_cll',critpointscnte2_cll,critpointscnte2_cll/real(pointscnte_cll)*1d2
2415  endif
2416  if(pointscntf_cll.ne.0.and.critpointscntf2_cll.ne.0) then
2417  write(ncpout2_cll,111) 'F_cll',critpointscntf2_cll,critpointscntf2_cll*1d2/pointscntf_cll
2418  endif
2419  if(pointscntg_cll.ne.0.and.critpointscntg2_cll.ne.0) then
2420  write(ncpout2_cll,111) 'G_cll',critpointscntg2_cll,critpointscntg2_cll*1d2/pointscntg_cll
2421  endif
2422  do i=1,nmax_cll
2423  if(pointscnttn_cll(i).ne.0.and.critpointscnttn2_cll(i).ne.0) then
2424  write(ncpout2_cll,112) 'TN_cll',i,critpointscnttn2_cll(i),critpointscnttn2_cll(i)*1d2/pointscnttn_cll(i)
2425  endif
2426  end do
2427  write(ncpout2_cll,*)
2428 
2429  if(pointscntdbten_cll.ne.0.and.critpointscntdbten_cll.ne.0) then
2430  write(ncpout2_cll,111) 'DBten_cll',critpointscntdbten_cll,critpointscntdbten_cll/real(pointscntdbten_cll)*1d2
2431  endif
2432  if(pointscntaten_cll.ne.0.and.critpointscntaten_cll.ne.0) then
2433  write(ncpout2_cll,111) 'Aten_cll',critpointscntaten_cll,critpointscntaten_cll/real(pointscntaten_cll)*1d2
2434  endif
2435  if(pointscntbten_cll.ne.0.and.critpointscntbten_cll.ne.0) then
2436  write(ncpout2_cll,111) 'Bten_cll',critpointscntbten_cll,critpointscntbten_cll/real(pointscntbten_cll)*1d2
2437  endif
2438  if(pointscntcten_cll.ne.0.and.critpointscntcten_cll.ne.0) then
2439  write(ncpout2_cll,111) 'Cten_cll',critpointscntcten_cll,critpointscntcten_cll/real(pointscntcten_cll)*1d2
2440  endif
2441  if(pointscntdten_cll.ne.0.and.critpointscntdten_cll.ne.0) then
2442  write(ncpout2_cll,111) 'Dten_cll',critpointscntdten_cll,critpointscntdten_cll/real(pointscntdten_cll)*1d2
2443  endif
2444  if(pointscnteten_cll.ne.0.and.critpointscnteten_cll.ne.0) then
2445  write(ncpout2_cll,111) 'Eten_cll',critpointscnteten_cll,critpointscnteten_cll/real(pointscnteten_cll)*1d2
2446  endif
2447  if(pointscntften_cll.ne.0.and.critpointscntften_cll.ne.0) then
2448  write(ncpout2_cll,111) 'Ften_cll',critpointscntften_cll,critpointscntften_cll*1d2/pointscntften_cll
2449  endif
2450  if(pointscntgten_cll.ne.0.and.critpointscntgten_cll.ne.0) then
2451  write(ncpout2_cll,111) 'Gten_cll',critpointscntgten_cll,critpointscntgten_cll*1d2/pointscntgten_cll
2452  endif
2453  do i=1,nmax_cll
2454  if(pointscnttnten_cll(i).ne.0.and.critpointscnttnten_cll(i).ne.0) then
2455  write(ncpout2_cll,112) 'TNten_cll',i,critpointscnttnten_cll(i),critpointscnttnten_cll(i)*1d2/pointscnttnten_cll(i)
2456  endif
2457  end do
2458  write(ncpout2_cll,*)
2459 
2460 501 format(' #calls all ',' = ',i20)
2461 511 format(' #calls with accuracy of level ',i3,' = ',i20,' or ',f10.5,' %')
2462 521 format(' #events all ',' = ',i20)
2463 531 format(' #events with accuracy of level ',i3,' = ',i20,' or ',f10.5,' %')
2464 
2465  write(ncpout2_cll,510)
2466 510 format (/' Numbers of COLLIER calls with accuracy levels')
2467  do i=-2,0
2468  write(ncpout2_cll,511) i,acccnt(i),acccnt(i)/real(acccnt(1))*1d2
2469  end do
2470  write(ncpout2_cll,501) acccnt(1)
2471 
2472  write(ncpout2_cll,500)
2473 500 format (/' Numbers of Events with accuracy levels')
2474  do i=-2,0
2475  write(ncpout2_cll,531) i,acceventcnt(i),acceventcnt(i)/real(acceventcnt(1))*1d2
2476  end do
2477  write(ncpout2_cll,521) acceventcnt(1)
2478 ! write(ncpout2_cll,521) EventCnt_cll+1
2479  write(ncpout2_cll,*)
2480 
2481 
2482 
2483 

◆ printstatistics_cll()

subroutine collier_aux::printstatistics_cll

Definition at line 1699 of file collier_aux.F90.

1699 
1700  integer :: i
1701 
1702 101 format(' #calls ',a9,' = ',i20)
1703 102 format(' #calls ',a9,' (N = ',i1,') = ',i20)
1704 111 format(' #calls ',a9,' = ',i20,' or ',f10.5,' %')
1705 112 format(' #calls ',a9,' (N = ',i1,') = ',i20,' or ',f10.5,' %')
1706 
1707  if (.not.monitoring) then
1708  if (infoutlev_cll.ge.1) then
1709  write(ninfout_cll,*) 'COLLIER: CritPointsMonitor not initialized'
1710  write(ninfout_cll,*) ' no statistics available '
1711  end if
1712  return
1713  else if(ncpout_cll.eq.closed_cll) then
1714  if (infoutlev_cll.ge.1) then
1715  write(ninfout_cll,*) 'COLLIER: Output for critical points switched off'
1716  end if
1717  return
1718  endif
1719 
1720  write(ncpout_cll,90)
1721 90 format (//' Collier: Summary of critical points:')
1722 
1723  write(ncpout_cll,100)
1724 100 format (/' Total numbers of calls of COLLIER functions')
1725 
1726  if( pointscnta_cll.ne.0) then
1727  write(ncpout_cll,101) 'A_cll',pointscnta_cll
1728  endif
1729  if( pointscntb_cll.ne.0) then
1730  write(ncpout_cll,101) 'B_cll',pointscntb_cll
1731  endif
1732  if( pointscntc_cll.ne.0) then
1733  write(ncpout_cll,101) 'C_cll',pointscntc_cll
1734  endif
1735  if( pointscntd_cll.ne.0) then
1736  write(ncpout_cll,101) 'D_cll',pointscntd_cll
1737  endif
1738  if( pointscnte_cll.ne.0) then
1739  write(ncpout_cll,101) 'E_cll',pointscnte_cll
1740  endif
1741  if( pointscntf_cll.ne.0) then
1742  write(ncpout_cll,101) 'F_cll',pointscntf_cll
1743  endif
1744  if( pointscntg_cll.ne.0) then
1745  write(ncpout_cll,101) 'G_cll',pointscntg_cll
1746  endif
1747  do i=1,nmax_cll
1748  if(pointscnttn_cll(i).ne.0) then
1749  write(ncpout_cll,102) 'TN_cll',i,pointscnttn_cll(i)
1750  endif
1751  end do
1752 
1753  if( pointscntaten_cll.ne.0) then
1754  write(ncpout_cll,101) 'Aten_cll',pointscntaten_cll
1755  endif
1756  if( pointscntbten_cll.ne.0) then
1757  write(ncpout_cll,101) 'Bten_cll',pointscntbten_cll
1758  endif
1759  if( pointscntcten_cll.ne.0) then
1760  write(ncpout_cll,101) 'Cten_cll',pointscntcten_cll
1761  endif
1762  if( pointscntdten_cll.ne.0) then
1763  write(ncpout_cll,101) 'Dten_cll',pointscntdten_cll
1764  endif
1765  if( pointscnteten_cll.ne.0) then
1766  write(ncpout_cll,101) 'Eten_cll',pointscnteten_cll
1767  endif
1768  if( pointscntften_cll.ne.0) then
1769  write(ncpout_cll,101) 'Ften_cll',pointscntften_cll
1770  endif
1771  if( pointscntgten_cll.ne.0) then
1772  write(ncpout_cll,101) 'Gten_cll',pointscntgten_cll
1773  endif
1774  do i=1,nmax_cll
1775  if(pointscnttnten_cll(i).ne.0) then
1776  write(ncpout_cll,102) 'TNten_cll',i,pointscnttnten_cll(i)
1777  endif
1778  end do
1779 
1780  write(ncpout_cll,110) reqacc_coli
1781 110 format (/' Numbers of calls of COLLIER functions'/ &
1782  ' with an estimated accuracy worse than reqacc_coli =',es11.4)
1783  if(pointscntdb_cll.ne.0.and.accpointscntdb_cll.ne.0) then
1784  write(ncpout_cll,111) 'DB_cll',accpointscntdb_cll,accpointscntdb_cll/real(pointscntdb_cll)*1d2
1785  endif
1786  if(pointscnta_cll.ne.0.and.accpointscnta_cll.ne.0) then
1787  write(ncpout_cll,111) 'A_cll',accpointscnta_cll,accpointscnta_cll/real(pointscnta_cll)*1d2
1788  endif
1789  if(pointscntb_cll.ne.0.and.accpointscntb_cll.ne.0) then
1790  write(ncpout_cll,111) 'B_cll',accpointscntb_cll,accpointscntb_cll/real(pointscntb_cll)*1d2
1791  endif
1792  if(pointscntc_cll.ne.0.and.accpointscntc_cll.ne.0) then
1793  write(ncpout_cll,111) 'C_cll',accpointscntc_cll,accpointscntc_cll/real(pointscntc_cll)*1d2
1794  endif
1795  if(pointscntd_cll.ne.0.and.accpointscntd_cll.ne.0) then
1796  write(ncpout_cll,111) 'D_cll',accpointscntd_cll,accpointscntd_cll/real(pointscntd_cll)*1d2
1797  endif
1798  if(pointscnte_cll.ne.0.and.accpointscnte_cll.ne.0) then
1799  write(ncpout_cll,111) 'E_cll',accpointscnte_cll,accpointscnte_cll/real(pointscnte_cll)*1d2
1800  endif
1801  if(pointscntf_cll.ne.0.and.accpointscntf_cll.ne.0) then
1802  write(ncpout_cll,111) 'F_cll',accpointscntf_cll,accpointscntf_cll*1d2/pointscntf_cll
1803  endif
1804  if(pointscntg_cll.ne.0.and.accpointscntg_cll.ne.0) then
1805  write(ncpout_cll,111) 'G_cll',accpointscntg_cll,accpointscntg_cll*1d2/pointscntg_cll
1806  endif
1807  do i=1,nmax_cll
1808  if(pointscnttn_cll(i).ne.0.and.accpointscnttn_cll(i).ne.0) then
1809  write(ncpout_cll,112) 'TN_cll',i,accpointscnttn_cll(i),accpointscnttn_cll(i)*1d2/pointscnttn_cll(i)
1810  endif
1811  end do
1812 
1813  if(pointscntdbten_cll.ne.0.and.accpointscntdbten_cll.ne.0) then
1814  write(ncpout_cll,111) 'DBten_cll',accpointscntdbten_cll,accpointscntdbten_cll/real(pointscntdbten_cll)*1d2
1815  endif
1816  if(pointscntaten_cll.ne.0.and.accpointscntaten_cll.ne.0) then
1817  write(ncpout_cll,111) 'Aten_cll',accpointscntaten_cll,accpointscntaten_cll/real(pointscntaten_cll)*1d2
1818  endif
1819  if(pointscntbten_cll.ne.0.and.accpointscntbten_cll.ne.0) then
1820  write(ncpout_cll,111) 'Bten_cll',accpointscntbten_cll,accpointscntbten_cll/real(pointscntbten_cll)*1d2
1821  endif
1822  if(pointscntcten_cll.ne.0.and.accpointscntcten_cll.ne.0) then
1823  write(ncpout_cll,111) 'Cten_cll',accpointscntcten_cll,accpointscntcten_cll/real(pointscntcten_cll)*1d2
1824  endif
1825  if(pointscntdten_cll.ne.0.and.accpointscntdten_cll.ne.0) then
1826  write(ncpout_cll,111) 'Dten_cll',accpointscntdten_cll,accpointscntdten_cll/real(pointscntdten_cll)*1d2
1827  endif
1828  if(pointscnteten_cll.ne.0.and.accpointscnteten_cll.ne.0) then
1829  write(ncpout_cll,111) 'Eten_cll',accpointscnteten_cll,accpointscnteten_cll/real(pointscnteten_cll)*1d2
1830  endif
1831  if(pointscntften_cll.ne.0.and.accpointscntften_cll.ne.0) then
1832  write(ncpout_cll,111) 'Ften_cll',accpointscntften_cll,accpointscntften_cll*1d2/pointscntften_cll
1833  endif
1834  if(pointscntgten_cll.ne.0.and.accpointscntgten_cll.ne.0) then
1835  write(ncpout_cll,111) 'Gten_cll',accpointscntgten_cll,accpointscntgten_cll*1d2/pointscntgten_cll
1836  endif
1837  do i=1,nmax_cll
1838  if(pointscnttnten_cll(i).ne.0.and.accpointscnttnten_cll(i).ne.0) then
1839  write(ncpout_cll,112) 'TNten_cll',i,accpointscnttnten_cll(i),accpointscnttnten_cll(i)*1d2/pointscnttnten_cll(i)
1840  endif
1841  end do
1842 
1843 ! write(ncpout_cll,130) sqrt(reqacc_coli)
1844 130 format (/' Numbers of calls of COLLIER functions'/ &
1845  ' with an estimated accuracy worse than '/ &
1846  ' sqrt(reqacc_coli) =',es11.4)
1847 
1848 
1849  write(ncpout_cll,120) critacc_cll
1850 120 format (/' Numbers of calls of COLLIER functions'/ &
1851  ' with an estimated accuracy worse than critacc_coli =',es11.4)
1852 
1853  if(pointscntdb_cll.ne.0.and.critpointscntdb_cll.ne.0) then
1854  write(ncpout_cll,111) 'DB_cll',critpointscntdb_cll,critpointscntdb_cll/real(pointscntdb_cll)*1d2
1855  endif
1856  if(pointscnta_cll.ne.0.and.critpointscnta_cll.ne.0) then
1857  write(ncpout_cll,111) 'A_cll',critpointscnta_cll,critpointscnta_cll/real(pointscnta_cll)*1d2
1858  endif
1859  if(pointscntb_cll.ne.0.and.critpointscntb_cll.ne.0) then
1860  write(ncpout_cll,111) 'B_cll',critpointscntb_cll,critpointscntb_cll/real(pointscntb_cll)*1d2
1861  endif
1862  if(pointscntc_cll.ne.0.and.critpointscntc_cll.ne.0) then
1863  write(ncpout_cll,111) 'C_cll',critpointscntc_cll,critpointscntc_cll/real(pointscntc_cll)*1d2
1864  endif
1865  if(pointscntd_cll.ne.0.and.critpointscntd_cll.ne.0) then
1866  write(ncpout_cll,111) 'D_cll',critpointscntd_cll,critpointscntd_cll/real(pointscntd_cll)*1d2
1867  endif
1868  if(pointscnte_cll.ne.0.and.critpointscnte_cll.ne.0) then
1869  write(ncpout_cll,111) 'E_cll',critpointscnte_cll,critpointscnte_cll/real(pointscnte_cll)*1d2
1870  endif
1871  if(pointscntf_cll.ne.0.and.critpointscntf_cll.ne.0) then
1872  write(ncpout_cll,111) 'F_cll',critpointscntf_cll,critpointscntf_cll*1d2/pointscntf_cll
1873  endif
1874  if(pointscntg_cll.ne.0.and.critpointscntg_cll.ne.0) then
1875  write(ncpout_cll,111) 'G_cll',critpointscntg_cll,critpointscntg_cll*1d2/pointscntg_cll
1876  endif
1877  do i=1,nmax_cll
1878  if(pointscnttn_cll(i).ne.0.and.critpointscnttn_cll(i).ne.0) then
1879  write(ncpout_cll,112) 'TN_cll',i,critpointscnttn_cll(i),critpointscnttn_cll(i)*1d2/pointscnttn_cll(i)
1880  endif
1881  end do
1882 
1883  if(pointscntdbten_cll.ne.0.and.critpointscntdbten_cll.ne.0) then
1884  write(ncpout_cll,111) 'DBten_cll',critpointscntdbten_cll,critpointscntdbten_cll/real(pointscntdbten_cll)*1d2
1885  endif
1886  if(pointscntaten_cll.ne.0.and.critpointscntaten_cll.ne.0) then
1887  write(ncpout_cll,111) 'Aten_cll',critpointscntaten_cll,critpointscntaten_cll/real(pointscntaten_cll)*1d2
1888  endif
1889  if(pointscntbten_cll.ne.0.and.critpointscntbten_cll.ne.0) then
1890  write(ncpout_cll,111) 'Bten_cll',critpointscntbten_cll,critpointscntbten_cll/real(pointscntbten_cll)*1d2
1891  endif
1892  if(pointscntcten_cll.ne.0.and.critpointscntcten_cll.ne.0) then
1893  write(ncpout_cll,111) 'Cten_cll',critpointscntcten_cll,critpointscntcten_cll/real(pointscntcten_cll)*1d2
1894  endif
1895  if(pointscntdten_cll.ne.0.and.critpointscntdten_cll.ne.0) then
1896  write(ncpout_cll,111) 'Dten_cll',critpointscntdten_cll,critpointscntdten_cll/real(pointscntdten_cll)*1d2
1897  endif
1898  if(pointscnteten_cll.ne.0.and.critpointscnteten_cll.ne.0) then
1899  write(ncpout_cll,111) 'Eten_cll',critpointscnteten_cll,critpointscnteten_cll/real(pointscnteten_cll)*1d2
1900  endif
1901  if(pointscntften_cll.ne.0.and.critpointscntften_cll.ne.0) then
1902  write(ncpout_cll,111) 'Ften_cll',critpointscntften_cll,critpointscntften_cll*1d2/pointscntften_cll
1903  endif
1904  if(pointscntgten_cll.ne.0.and.critpointscntgten_cll.ne.0) then
1905  write(ncpout_cll,111) 'Gten_cll',critpointscntgten_cll,critpointscntgten_cll*1d2/pointscntgten_cll
1906  endif
1907  do i=1,nmax_cll
1908  if(pointscnttnten_cll(i).ne.0.and.critpointscnttnten_cll(i).ne.0) then
1909  write(ncpout_cll,112) 'TNten_cll',i,critpointscnttnten_cll(i),critpointscnttnten_cll(i)*1d2/pointscnttnten_cll(i)
1910  endif
1911  end do
1912  write(ncpout_cll,*)
1913 
1914 
1915  if (qopened_check) then
1916  write(ncheckout_cll,290)
1917 290 format (//' Collier: Summary of COLI/DD use in mode 3:')
1918 
1919  write(ncheckout_cll,300)
1920 300 format (/' Total numbers of uses of COLI functions')
1921 
1922  if( pointscntdb_coli.ne.0) then
1923  write(ncheckout_cll,111) 'DB_cll',pointscntdb_coli, &
1924  pointscntdb_coli*1d2/(pointscntdb_coli+pointscntdb_dd)
1925  endif
1926  if( pointscnta_coli.ne.0) then
1927  write(ncheckout_cll,111) 'A_cll',pointscnta_coli, &
1928  pointscnta_coli*1d2/(pointscnta_coli+pointscnta_dd)
1929  endif
1930  if( pointscntb_coli.ne.0) then
1931  write(ncheckout_cll,111) 'B_cll',pointscntb_coli, &
1932  pointscntb_coli*1d2/(pointscntb_coli+pointscntb_dd)
1933  endif
1934  if( pointscntc_coli.ne.0) then
1935  write(ncheckout_cll,111) 'C_cll',pointscntc_coli, &
1936  pointscntc_coli*1d2/(pointscntc_coli+pointscntc_dd)
1937  endif
1938  if( pointscntd_coli.ne.0) then
1939  write(ncheckout_cll,111) 'D_cll',pointscntd_coli, &
1940  pointscntd_coli*1d2/(pointscntd_coli+pointscntd_dd)
1941  endif
1942  if( pointscnte_coli.ne.0) then
1943  write(ncheckout_cll,111) 'E_cll',pointscnte_coli, &
1944  pointscnte_coli*1d2/(pointscnte_coli+pointscnte_dd)
1945  endif
1946  if( pointscntf_coli.ne.0) then
1947  write(ncheckout_cll,111) 'F_cll',pointscntf_coli, &
1948  pointscntf_coli*1d2/(pointscntf_coli+pointscntf_dd)
1949  endif
1950  if( pointscntg_coli.ne.0) then
1951  write(ncheckout_cll,111) 'G_cll',pointscntg_coli, &
1952  pointscntg_coli*1d2/(pointscntg_coli+pointscntg_dd)
1953  endif
1954  do i=1,nmax_cll
1955  if(pointscnttn_coli(i).ne.0) then
1956  write(ncheckout_cll,112) 'TN_cll',i,pointscnttn_coli(i), &
1957  pointscnttn_coli(i)*1d2/(pointscnttn_coli(i)+pointscnttn_dd(i))
1958  endif
1959  end do
1960 
1961  if( pointscntaten_coli.ne.0) then
1962  write(ncheckout_cll,111) 'Aten_cll',pointscntaten_coli, &
1963  pointscntaten_coli*1d2/(pointscntaten_coli+pointscntaten_dd)
1964  endif
1965  if( pointscntbten_coli.ne.0) then
1966  write(ncheckout_cll,111) 'Bten_cll',pointscntbten_coli, &
1967  pointscntbten_coli*1d2/(pointscntbten_coli+pointscntbten_dd)
1968  endif
1969  if( pointscntcten_coli.ne.0) then
1970  write(ncheckout_cll,111) 'Cten_cll',pointscntcten_coli, &
1971  pointscntcten_coli*1d2/(pointscntcten_coli+pointscntcten_dd)
1972  endif
1973  if( pointscntdten_coli.ne.0) then
1974  write(ncheckout_cll,111) 'Dten_cll',pointscntdten_coli, &
1975  pointscntdten_coli*1d2/(pointscntdten_coli+pointscntdten_dd)
1976  endif
1977  if( pointscnteten_coli.ne.0) then
1978  write(ncheckout_cll,111) 'Eten_cll',pointscnteten_coli, &
1979  pointscnteten_coli*1d2/(pointscnteten_coli+pointscnteten_dd)
1980  endif
1981  if( pointscntften_coli.ne.0) then
1982  write(ncheckout_cll,111) 'Ften_cll',pointscntften_coli, &
1983  pointscntften_coli*1d2/(pointscntften_coli+pointscntften_dd)
1984  endif
1985  if( pointscntgten_coli.ne.0) then
1986  write(ncheckout_cll,111) 'Gten_cll',pointscntgten_coli, &
1987  pointscntgten_coli*1d2/(pointscntgten_coli+pointscntgten_dd)
1988  endif
1989  do i=1,nmax_cll
1990  if(pointscnttnten_coli(i).ne.0) then
1991  write(ncheckout_cll,112) 'TNten_cll',i,pointscnttnten_coli(i), &
1992  pointscnttnten_coli(i)*1d2/(pointscnttnten_coli(i)+pointscnttnten_dd(i))
1993  endif
1994  end do
1995 
1996  write(ncheckout_cll,210)
1997 210 format (/' Total numbers of uses of DD functions')
1998 
1999  if( pointscntdb_dd.ne.0) then
2000  write(ncheckout_cll,111) 'DB_cll',pointscntdb_dd, &
2001  pointscntdb_dd*1d2/(pointscntdb_coli+pointscntdb_dd)
2002  endif
2003  if( pointscnta_dd.ne.0) then
2004  write(ncheckout_cll,111) 'A_cll',pointscnta_dd, &
2005  pointscnta_dd*1d2/(pointscnta_coli+pointscnta_dd)
2006  endif
2007  if( pointscntb_dd.ne.0) then
2008  write(ncheckout_cll,111) 'B_cll',pointscntb_dd, &
2009  pointscntb_dd*1d2/(pointscntb_coli+pointscntb_dd)
2010  endif
2011  if( pointscntc_dd.ne.0) then
2012  write(ncheckout_cll,111) 'C_cll',pointscntc_dd, &
2013  pointscntc_dd*1d2/(pointscntc_coli+pointscntc_dd)
2014  endif
2015  if( pointscntd_dd.ne.0) then
2016  write(ncheckout_cll,111) 'D_cll',pointscntd_dd, &
2017  pointscntd_dd*1d2/(pointscntd_coli+pointscntd_dd)
2018  endif
2019  if( pointscnte_dd.ne.0) then
2020  write(ncheckout_cll,111) 'E_cll',pointscnte_dd, &
2021  pointscnte_dd*1d2/(pointscnte_coli+pointscnte_dd)
2022  endif
2023  if( pointscntf_dd.ne.0) then
2024  write(ncheckout_cll,111) 'F_cll',pointscntf_dd, &
2025  pointscntf_dd*1d2/(pointscntf_coli+pointscntf_dd)
2026  endif
2027  if( pointscntg_dd.ne.0) then
2028  write(ncheckout_cll,111) 'G_cll',pointscntg_dd, &
2029  pointscntg_dd*1d2/(pointscntg_coli+pointscntg_dd)
2030  endif
2031  do i=1,nmax_cll
2032  if(pointscnttn_dd(i).ne.0) then
2033  write(ncheckout_cll,112) 'TN_cll',i,pointscnttn_dd(i), &
2034  pointscnttn_dd(i)*1d2/(pointscnttn_coli(i)+pointscnttn_dd(i))
2035  endif
2036  end do
2037 
2038  if( pointscntaten_dd.ne.0) then
2039  write(ncheckout_cll,111) 'Aten_cll',pointscntaten_dd, &
2040  pointscntaten_dd*1d2/(pointscntaten_coli+pointscntaten_dd)
2041  endif
2042  if( pointscntbten_dd.ne.0) then
2043  write(ncheckout_cll,111) 'Bten_cll',pointscntbten_dd, &
2044  pointscntbten_dd*1d2/(pointscntbten_coli+pointscntbten_dd)
2045  endif
2046  if( pointscntcten_dd.ne.0) then
2047  write(ncheckout_cll,111) 'Cten_cll',pointscntcten_dd, &
2048  pointscntcten_dd*1d2/(pointscntcten_coli+pointscntcten_dd)
2049  endif
2050  if( pointscntdten_dd.ne.0) then
2051  write(ncheckout_cll,111) 'Dten_cll',pointscntdten_dd, &
2052  pointscntdten_dd*1d2/(pointscntdten_coli+pointscntdten_dd)
2053  endif
2054  if( pointscnteten_dd.ne.0) then
2055  write(ncheckout_cll,111) 'Eten_cll',pointscnteten_dd, &
2056  pointscnteten_dd*1d2/(pointscnteten_coli+pointscnteten_dd)
2057  endif
2058  if( pointscntften_dd.ne.0) then
2059  write(ncheckout_cll,111) 'Ften_cll',pointscntften_dd, &
2060  pointscntften_dd*1d2/(pointscntften_coli+pointscntften_dd)
2061  endif
2062  if( pointscntgten_dd.ne.0) then
2063  write(ncheckout_cll,111) 'Gten_cll',pointscntgten_dd, &
2064  pointscntgten_dd*1d2/(pointscntgten_coli+pointscntgten_dd)
2065  endif
2066  do i=1,nmax_cll
2067  if(pointscnttnten_dd(i).ne.0) then
2068  write(ncheckout_cll,112) 'TNten_cll',i,pointscnttnten_dd(i), &
2069  pointscnttnten_dd(i)*1d2/(pointscnttnten_coli(i)+pointscnttnten_dd(i))
2070  endif
2071  end do
2072 
2073  write(ncheckout_cll,220)
2074 220 format (/' Total numbers of calls of COLI/DD functions')
2075 
2076  if( pointscntdb_coli+pointscntdb_dd.ne.0) then
2077  write(ncheckout_cll,101) 'DB_cll',pointscntdb_coli+pointscntdb_dd
2078  endif
2079  if( pointscnta_coli+pointscnta_dd.ne.0) then
2080  write(ncheckout_cll,101) 'A_cll',pointscnta_coli+pointscnta_dd
2081  endif
2082  if( pointscntb_coli+pointscntb_dd.ne.0) then
2083  write(ncheckout_cll,101) 'B_cll',pointscntb_coli+pointscntb_dd
2084  endif
2085  if( pointscntc_coli+pointscntc_dd.ne.0) then
2086  write(ncheckout_cll,101) 'C_cll',pointscntc_coli+pointscntc_dd
2087  endif
2088  if( pointscntd_coli+pointscntd_dd.ne.0) then
2089  write(ncheckout_cll,101) 'D_cll',pointscntd_coli+pointscntd_dd
2090  endif
2091  if( pointscnte_coli+pointscnte_dd.ne.0) then
2092  write(ncheckout_cll,101) 'E_cll',pointscnte_coli+pointscnte_dd
2093  endif
2094  if( pointscntf_coli+pointscntf_dd.ne.0) then
2095  write(ncheckout_cll,101) 'F_cll',pointscntf_coli+pointscntf_dd
2096  endif
2097  if( pointscntg_coli+pointscntg_dd.ne.0) then
2098  write(ncheckout_cll,101) 'G_cll',pointscntg_coli+pointscntg_dd
2099  endif
2100  do i=1,nmax_cll
2101  if(pointscnttn_coli(i)+pointscnttn_dd(i).ne.0) then
2102  write(ncheckout_cll,102) 'TN_cll',i,pointscnttn_coli(i)+pointscnttn_dd(i)
2103  endif
2104  end do
2105 
2106  if( pointscntdbten_coli+pointscntdbten_dd.ne.0) then
2107  write(ncheckout_cll,101) 'DBten_cll',pointscntdbten_coli+pointscntdbten_dd
2108  endif
2109  if( pointscntaten_coli+pointscntaten_dd.ne.0) then
2110  write(ncheckout_cll,101) 'Aten_cll',pointscntaten_coli+pointscntaten_dd
2111  endif
2112  if( pointscntbten_coli+pointscntbten_dd.ne.0) then
2113  write(ncheckout_cll,101) 'Bten_cll',pointscntbten_coli+pointscntbten_dd
2114  endif
2115  if( pointscntcten_coli+pointscntcten_dd.ne.0) then
2116  write(ncheckout_cll,101) 'Cten_cll',pointscntcten_coli+pointscntcten_dd
2117  endif
2118  if( pointscntdten_coli+pointscntdten_dd.ne.0) then
2119  write(ncheckout_cll,101) 'Dten_cll',pointscntdten_coli+pointscntdten_dd
2120  endif
2121  if( pointscnteten_coli+pointscnteten_dd.ne.0) then
2122  write(ncheckout_cll,101) 'Eten_cll',pointscnteten_coli+pointscnteten_dd
2123  endif
2124  if( pointscntften_coli+pointscntften_dd.ne.0) then
2125  write(ncheckout_cll,101) 'Ften_cll',pointscntften_coli+pointscntften_dd
2126  endif
2127  if( pointscntgten_coli+pointscntgten_dd.ne.0) then
2128  write(ncheckout_cll,101) 'Gten_cll',pointscntgten_coli+pointscntgten_dd
2129  endif
2130  do i=1,nmax_cll
2131  if(pointscnttnten_coli(i)+pointscnttnten_dd(i).ne.0) then
2132  write(ncheckout_cll,102) 'TNten_cll',i,pointscnttnten_coli(i)+pointscnttnten_dd(i)
2133  endif
2134  end do
2135 
2136  write(ncheckout_cll,320)
2137 320 format (/' Numbers of comparisons of functions between COLI and DD')
2138 
2139  if(checkcntdb_cll.ne.0) then
2140  write(ncheckout_cll,101) 'DB_cll',checkcntdb_cll
2141  endif
2142  do i=1,nmax_cll
2143  if(checkcnt_cll(i).ne.0) then
2144  write(ncheckout_cll,102) 'TN_cll',i,checkcnt_cll(i)
2145  endif
2146  end do
2147  do i=1,nmax_cll
2148  if(checkcntten_cll(i).ne.0) then
2149  write(ncheckout_cll,102) 'TNten_cll',i,checkcntten_cll(i)
2150  endif
2151  end do
2152 
2153  write(ncheckout_cll,330) checkacc_cll
2154 330 format (/' Numbers of calls of COLLIER functions'/ &
2155  ' with difference between COLI and DD > checkacc_cll =',es11.4)
2156 
2157  if(diffcntdb_cll.ne.0) then
2158  write(ncheckout_cll,111) 'DB_cll',diffcntdb_cll, &
2159  diffcntdb_cll*1d2/checkcntdb_cll
2160  endif
2161  do i=1,nmax_cll
2162  if(diffcnt_cll(i).ne.0) then
2163  write(ncheckout_cll,112) 'TN_cll',i,diffcnt_cll(i), &
2164  diffcnt_cll(i)*1d2/checkcnt_cll(i)
2165  endif
2166  end do
2167  if(diffcntec_cll.ne.0) then
2168  write(ncheckout_cll,111) 'E_cll',diffcntec_cll, &
2169  diffcntec_cll*1d2/checkcnt_cll(5)
2170  endif
2171  do i=1,nmax_cll
2172  if(diffcntten_cll(i).ne.0) then
2173  write(ncheckout_cll,112) 'TNten_cll',i,diffcntten_cll(i), &
2174  diffcntten_cll(i)*1d2/checkcntten_cll(i)
2175  endif
2176  end do
2177 
2178  end if ! qopend_check
2179 
2180  erreventcnt(1) = erreventcnt(1) + 1
2181  erreventcnt(errflag_cll) = erreventcnt(errflag_cll) + 1
2182  acceventcnt(1) = acceventcnt(1) + 1
2183  acceventcnt(accflag_cll) = acceventcnt(accflag_cll) + 1
2184 
2185 401 format(' #calls all ',' = ',i20)
2186 411 format(' #calls with errors of level ',i3,' = ',i20,' or ',f10.5,' %')
2187 421 format(' #events all ',' = ',i20)
2188 431 format(' #events with errors of level ',i3,' = ',i20,' or ',f10.5,' %')
2189 
2190  write(nerrout_cll,400)
2191 400 format (/' Numbers of errors in COLI functions')
2192  do i=-10,0
2193  write(nerrout_cll,411) i,errcntcoli(i),errcntcoli(i)/real(errcnt(1))*1d2
2194  end do
2195  write(nerrout_cll,401) errcnt(1)
2196 
2197  write(nerrout_cll,405)
2198 405 format (/' Numbers of errors in DD functions')
2199  do i=-10,0
2200  write(nerrout_cll,411) i,errcntdd(i),errcntdd(i)/real(errcnt(1))*1d2
2201  end do
2202  write(nerrout_cll,401) errcnt(1)
2203 
2204  write(nerrout_cll,410)
2205 410 format (/' Numbers of errors in COLLIER functions')
2206  do i=-10,0
2207  write(nerrout_cll,411) i,errcnt(i),errcnt(i)/real(errcnt(1))*1d2
2208  end do
2209  write(nerrout_cll,401) errcnt(1)
2210 
2211  write(nerrout_cll,415)
2212 415 format (/' Numbers of errors in Events')
2213  do i=-10,0
2214  write(nerrout_cll,431) i,erreventcnt(i),erreventcnt(i)/real(erreventcnt(1))*1d2
2215  end do
2216  write(nerrout_cll,421) erreventcnt(1)
2217 
2218 
2219 501 format(' #calls all ',' = ',i20)
2220 511 format(' #calls with accuracy of level ',i3,' = ',i20,' or ',f10.5,' %')
2221 521 format(' #events all ',' = ',i20)
2222 531 format(' #events with accuracy of level ',i3,' = ',i20,' or ',f10.5,' %')
2223 
2224  write(ncpout_cll,510)
2225 510 format (/' Numbers of COLLIER calls with accuracy levels')
2226  do i=-2,0
2227  write(ncpout_cll,511) i,acccnt(i),acccnt(i)/real(acccnt(1))*1d2
2228  end do
2229  write(ncpout_cll,501) acccnt(1)
2230 
2231  write(ncpout_cll,500)
2232 500 format (/' Numbers of Events with accuracy levels')
2233  do i=-2,0
2234  write(ncpout_cll,531) i,acceventcnt(i),acceventcnt(i)/real(acceventcnt(1))*1d2
2235  end do
2236  write(ncpout_cll,521) acceventcnt(1)
2237 ! write(ncpout_cll,521) EventCnt_cll+1
2238  write(ncpout_cll,*)
2239 
2240 
2241 
2242 
2243 
endif
O0 g endif() string(TOLOWER "$
Definition: CMakeLists.txt:143