*###[ ffabcd: subroutine ffabcd(aijkl,xpi,dpipj,piDpj,del2s,sdel2s, + in,jn,jin,isji, kn,ln,lkn,islk, ns, ifirst, ier) ***#[*comment:*********************************************************** * * * Calculate the a,b,c,d of the equation for qij.qkl * * * * a = s4.s4^2 * * * * si sj sk sl / sm sn sm sn sm sn mu ro\ * * -b/2 = d d |d d - d s4 s4 | * * mu nu nu ro \ mu s4 ro s4 sm sn / * * * * _ si sj sk sl / mu s4 ro mu s4 ro\ * * vD/2 = d d |d s4 + d s4 | * * mu nu nu ro \ s3 s4 s3 s4 / * * * * with sm = s3, sn = s4 * * p(jin) = isji*(sj-si) * * p(lkn) = islk*(sl-sk) * * * * Input: xpi(ns) as usual * * dpipj(ns,ns) -"- * * piDpj(ns,ns) -"- * * in,jn,jin,isjn see above * * kn,ln,lkn,islk see above * * * * Output: del4d2 see above * * * ***#]*comment:*********************************************************** * #[ declarations: implicit none * * arguments: * integer in,jn,jin,isji,kn,ln,lkn,islk,ns,ifirst, + ier DOUBLE PRECISION aijkl,xpi(10),dpipj(10,10),piDpj(10,10),del2s DOUBLE PRECISION sdel2s * * local variables: * integer i,j,ji,k,l,lk,isii integer ii,ll integer iii(6,2) save iii logical ldet(4) DOUBLE PRECISION xa,xb,xc,xd,s(24),del3(4),som,somb,somd,xbp, + xdp,smaxp,smax,save,xmax,rloss,del2d2,dum,del2i,del2j, + del2ji,del2k,del2l,del2lk,d2d2i,d2d2j,d2d2ji,d2d2k, + d2d2l,d2d2lk,d3d2m,d3d2n,d3d2nm save del3,ldet * * common blocks: * include 'ff.h' * * data * data iii / 0,3,4,0,7,0, + 0,3,4,0,7,0/ * data isign/1,1,1,0,1,0, * + 1,1,1,0,1,0/ * #] declarations: * #[ initialisaties: if ( ifirst .eq. 0 ) then ifirst = ifirst + 1 ldet(2) = .FALSE. ldet(3) = .FALSE. ldet(4) = .FALSE. endif xa = xpi(4)**2 * #] initialisaties: * #[ check input: if ( ltest ) then if ( abs(isji) .ne. 1 ) print *,'ff2d22: error: abs(isji)', + ' /= 1',isji if ( abs(islk) .ne. 1 ) print *,'ff2d22: error: abs(islk)', + ' /= 1',islk if ( ns .ne. 10 ) print *,'ffabcd: only valid for ns=10!!' endif * #] check input: * #[ prepare input: i = in j = jn ji = jin k = kn l = ln lk = lkn * sort it so that i