328 integer,
intent(in) :: rmax
329 double complex,
intent(in) :: p10,m02,m12
330 double precision :: q10
331 double complex :: mm02,mm12
332 double complex,
intent(out) :: Buv(0:rmax/2,0:rmax)
333 double complex,
intent(out) :: B(0:rmax/2,0:rmax)
334 double precision,
optional,
intent(out) :: Berr(0:rmax)
335 integer,
optional,
intent(in) :: id_in
336 double complex :: B2uv(0:rmax/2,0:rmax), B2(0:rmax/2,0:rmax)
337 double complex :: Bcoliuv(0:rmax,0:rmax)
338 double complex :: Bcoli(0:rmax,0:rmax)
339 double complex :: Bdduv(0:rmax,0:rmax)
340 double complex :: Bdd(0:rmax,0:rmax)
341 double precision :: Berraux(0:rmax),Bdiff(0:rmax)
342 double complex :: args(3)
343 integer :: n0,rank,errflag,id,r
344 double precision :: accrelDD(0:rmax_DD),accabsDD(0:rmax_DD)
345 double precision :: accrel2DD(0:rmax_DD),accabs2DD(0:rmax_DD)
346 double precision :: Bacc(0:rmax),Bacc2(0:rmax),norm,norm_coli,norm_dd
347 integer :: accflagDD,errflagDD,NDD,rankDD
348 logical :: mflag,eflag
350 if (2.gt.nmax_cll) then
351 call seterrflag_cll(-10)
352 call errout_cll(
'B_cll',
'Nmax_cll smaller 2',eflag,.true.)
353 write(nerrout_cll,*)
'Nmax_cll =',nmax_cll
354 write(nerrout_cll,*)
'Reinitialize COLLIER with Nmax_cll >= 2'
355 call propagateerrflag_cll
358 if (rmax.gt.rmax_cll) then
359 call seterrflag_cll(-10)
360 call errout_cll(
'B_cll',
'argument rmax larger than rmax_cll',eflag,.true.)
361 write(nerrout_cll,*)
'rmax =',rmax
362 write(nerrout_cll,*)
'rmax_cll =',rmax_cll
363 write(nerrout_cll,*)
'Reinitialize COLLIER with rmax_cll >= ',rmax
364 call propagateerrflag_cll
369 if (
present(id_in)) then
381 call setmasterfname_cll(
'B_cll')
382 call setmastern_cll(2)
383 call setmasterr_cll(rmax)
384 call setmasterargs_cll(3,args)
386 call settencache_cll(never_tenred_cll)
390 select case (mode_cll)
396 call calcb(bcoli,bcoliuv,p10,m02,m12,rmax,id,berraux)
398 norm = maxval(abs(bcoli(0,0:rmax)))
399 if (norm.ne.0d0) then
405 if (
present(berr)) then
409 if (mflag)
call propagateaccflag_cll(bacc,rmax)
411 b(0:rmax/2,0:rmax) = bcoli(0:rmax/2,0:rmax)
412 buv(0:rmax/2,0:rmax) = bcoliuv(0:rmax/2,0:rmax)
421 q10 = dreal(getminf2dd_cll(p10))
422 mm02 = getminf2dd_cll(m02)
423 mm12 = getminf2dd_cll(m12)
426 call b_dd(bdd,bdduv,q10,mm02,mm12,rank,id)
428 b(n0,0:rank) = bdd(n0,0:rank)
429 buv(n0,0:rank) = bdduv(n0,0:rank)
432 call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
433 if (
present(berr)) then
434 berr(0:rmax) = accabsdd(0:rmax)
437 norm = maxval(abs(b(0,0:rmax)))
438 if (norm.ne.0d0) then
439 bacc = accabsdd(0:rmax)/norm
441 bacc = accabsdd(0:rmax)
443 if (mflag)
call propagateaccflag_cll(bacc,rmax)
453 call calcb(bcoli,bcoliuv,p10,m02,m12,rmax,id,berraux)
455 b(0:rmax/2,0:rmax) = bcoli(0:rmax/2,0:rmax)
456 buv(0:rmax/2,0:rmax) = bcoliuv(0:rmax/2,0:rmax)
464 q10 = dreal(getminf2dd_cll(p10))
465 mm02 = getminf2dd_cll(m02)
466 mm12 = getminf2dd_cll(m12)
469 call b_dd(bdd,bdduv,q10,mm02,mm12,rank,0)
471 b2(n0,0:rmax) = bdd(n0,0:rmax)
472 b2uv(n0,0:rmax) = bdduv(n0,0:rmax)
474 call ddgetacc(accreldd,accabsdd,accrel2dd,accabs2dd,ndd,rankdd,accflagdd,errflagdd,id)
476 norm_coli = maxval(abs(b(0,0:rmax)))
477 if (norm_coli.eq.0d0) norm_coli = 1d0
478 norm_dd = maxval(abs(b2(0,0:rmax)))
479 if (norm_dd.eq.0d0) norm_dd = 1d0
480 norm = min(norm_coli,norm_dd)
483 call checkcoefsb_cll(b,b2,p10,m02,m12,rmax,norm,bdiff)
485 if (berraux(rmax).lt.accabsdd(rmax)) then
486 if (
present(berr)) berr = max(berraux,bdiff)
487 bacc = max(berraux/norm_coli,bdiff/norm)
488 if (monitoring) pointscntb_coli = pointscntb_coli + 1
492 if (
present(berr)) berr = max(accabsdd(0:rmax),bdiff)
493 bacc = max(accabsdd(0:rmax)/norm_dd,bdiff/norm)
494 if (monitoring) pointscntb_dd = pointscntb_dd + 1
497 if (mflag)
call propagateaccflag_cll(bacc,rmax)
501 if (mflag)
call propagateerrflag_cll
504 pointscntb_cll = pointscntb_cll + 1
506 if(maxval(bacc).gt.reqacc_cll) accpointscntb_cll = accpointscntb_cll + 1
508 if(maxval(bacc).gt.critacc_cll) then
509 critpointscntb_cll = critpointscntb_cll + 1
510 if ( critpointscntb_cll.le.noutcritpointsmax_cll(2) ) then
511 call critpointsout_cll(
'B_cll',0,maxval(bacc), critpointscntb_cll)
512 if( critpointscntb_cll.eq.noutcritpointsmax_cll(2)) then
513 write(ncpout_cll,*)
' Further output of Critical Points for B_cll suppressed '