*
*-----WTOXSC-----------------------------------------------------------
*
      real*8 function wtoxsc(ndim,x)
      implicit real*8 (a-h,o-z)
*
      character*1,ocoul,opeak,oqcd,ofl,ofsr,obin,om,osm,oww,ozz,
     #            opeaka,rio,opeakas,ockm,omdist
      character*4,otype
*
      parameter(ninv=10,npos=512)
*
      common/wtai/rio
      common/wtgd/idt
      common/wtcw/oww
      common/wtcz/ozz
      common/wtmod/om
      common/wtmp/zrm
      common/wtcb/obin
      common/wtfls/ofl
      common/wtqcd/als
      common/wtnpr/ipr
      common/wtsmod/osm
      common/wtdis/dist
      common/wtps/opeak
      common/wtkount/ik
      common/wtfsr/ofsr
      common/wtopa/delc
      common/wtckm/ockm
      common/wtsfls/sofl
      common/wtap/opeaka
      common/wtaqcd/oqcd
      common/wtistrf/isf
      common/wtcqcd/iqcd
      common/wtlmsb/qcdl
      common/wtickm/ickm
      common/wtomd/omdist
      common/wtsf/ix0,it0
      common/wtcoul/ocoul
      common/wtshel/otrans
      common/wtipt/ifz(51)
      common/wticuts/iac(4)
      common/wtmd/arrinv(10)
      common/wtisa/isaa,isab
      common/wtcx/xscmx(npos)
      common/wthx/xshmx(npos)
      common/wtochannel/otype
      common/wtparc/xap(ninv)
      common/wtvckm/vckm(3,3)
      common/wtpmx/xmx(npos,9)
      common/wtparh/xaph(ninv)
      common/wtparam/eps,ddelta
      common/wttc/itc,itcc,itcn                                       
      common/wtdis2/distm,distp
      common/wtpmxh/xmxh(npos,9)
      common/wtlb/abp,bbp,abm,bbm
      common/wtcclr/vupl,vupr,vdpl,vdpr
      common/wtalqed/arezm,aizm,aresz,aisz
      common/wtcmplx/sw(2),sz(2),rsw(2),rsz(2)
      common/wtnclr/vel,ver,velr,vfl,vfr,vfpl,vfpr
      common/wtcchannel/chu,chup,chd,chdp,fcuc,fcdc
      common/wthapar/rhm,rhm2,rhg,rhmg,shg,shgs,opshgs
      common/wtbpar/wm,zm,zg,gf,pi,pis,cfct,fcnt,ge,alphai,alwi
      common/wtfmass/em,rmm,tm,rnm,uqm,dqm,cqm,sqm,bqm,tqm,dmy
      common/wtacc/acg1g,aclg,ackg,acg4g,acktg,acltg,acg5g,
     #           acg1z,aclz,ackz,acg4z,acktz,acltz,acg5z
      common/wtfmass2/em2,amm2,tm2,rnm2,uqm2,dqm2,cqm2,sqm2,bqm2,
     #              tqm2,dmy2
      common/wtacchannel/omchu,opchu,omchup,opchup,omchdp,opchdp,
     #                 omchd,opchd,hchup,hchu,hchdp,hchd
      common/wtcpar/alpha,hbet,hbeti,omhb,eob,d0gl,g8,tfact,pih,alw,
     #            eta,feta,beta,g2,tfacth
      common/wtapar/ars,s,rwm,rwm2,rwg,rwmg,swg,swgs,opswgs,sth2,cth2,
     #            hsth2,tsth2,scth2,asth2,tth2,rzm,rzm2,rzg,rzmg,szg,
     #            szgs,opszgs,sth4,cth4,ve,vf,vfp,rbqm2,rszw,rszw2,
     #            s0w,s0z
      common/wtsubreg/dsm,usm,dsp,usp,rl(6),rr(6),srl(6),sdsm,sdsp,vvl1,
     #              vvl2,vvl3,ul,omul,suml
      common/wtcuts/aim(6),bim(6),ae(4),asa(4),bsa(4),afsa(6),bfsa(6),
     #            ombsa(4),opbsa(4),teq,rae(4),omasa(4),opasa(4),
     #            sg12,cg12,sg13,cg13,sg14,cg14,sg23,cg23,sg24,
     #            cg24,sg34,cg34,sct120,sct130,sct140,sct230,
     #            sct240,sct340,sgam(4),cgam(4)
*
      dimension co(2)
      dimension x(ndim)
      dimension fsr(2,2)
      dimension bt1(2),bt2(2)
      dimension bvv1(2),bvv2(2)
      dimension rru1(2),rru2(2)
      dimension sfur(2),sflr(2)
      dimension ret1(2),ret2(2)
      dimension ee(5),e(5),sg(5)
      dimension emu(4,2),emut(4)
      dimension ctmu(2),ctmu2(2)
      dimension bvvv1(2),bvvv2(2)
      dimension rrr(6),rrl(6),srrl(6)
      dimension bl(4),xbl(4),ss(4),cs(4)
      dimension tgn(15),tgg(24),tgv(48),tgh(9)
      dimension t1mu(2),t2mu(2),t3mu(2),t4mu(2)
      dimension ca3(2,6),ca2(2,4),ca1(2,2),ca0(2)
      dimension cb3(2,6),cb2(2,4),cb1(2,2),cb0(2)
      dimension c03(2,6),c02(2,4),c01(2,2),c00(2)
      dimension cp3(2,6),cp2(2,4),cp1(2,2),cp0(2)
      dimension cm3(2,6),cm2(2,4),cm1(2,2),cm0(2)
      dimension cc3(2,6),cc2(2,4),cc1(2,2),cc0(2)
      dimension eca3(2,6),eca2(2,4),eca1(2,2),eca0(2)
      dimension ecb3(2,6),ecb2(2,4),ecb1(2,2),ecb0(2)
      dimension ec03(2,6),ec02(2,4),ec01(2,2),ec00(2)
      dimension ecp3(2,6),ecp2(2,4),ecp1(2,2),ecp0(2)
      dimension ecm3(2,6),ecm2(2,4),ecm1(2,2),ecm0(2)
      dimension ecc3(2,6),ecc2(2,4),ecc1(2,2),ecc0(2)
      dimension p3qw(2),p3qm(2),p3qp(2),fzw(2),fzm(2),fzp(2),
     #          p3qs(2),fzs(2),fzsw(2),p3qsw(2)
      dimension dpxs(2,2,2,3),epxs(2,2,2,3),cpxs(2,3),bpxs(2,3),
     #          apxs(3)
      dimension rr1(2),rr2(2),rs1(2),rs2(2),rtp(2),rtm(2)
      dimension efsr1(2,2),efsr2(2,2),efsr3(2,2),efsr4(2,2)
      dimension fw(2),fws(2),pggfs(2),pgglqs(2),p3qsz(2),fzsz(2),
     #          fwsz(2),pggfsz(2),pgglqsz(2),fwsm(2),fwsp(2),
     #          fwsw(2),p3q14(2),fz14(2),fw14(2),p3q23(2),fz23(2),
     #          fw23(2),pggf23(2),pgglq23(2),pggfzm(2),pgglqzm(2)
      dimension f1(2),f2(2),f3(2),f4(2),ft1(2),ft2(2),ft3(2),ft4(2),
     #          ft5(2),ft6(2),ftz1(2),ftz2(2),ftz3(2),ftz4(2),ftz5(2),
     #          ftz6(2)
      dimension h1(2),h2(2),h3(2),h4(2),ht1(2),ht2(2),ht3(2),ht4(2),
     #          ht5(2),ht6(2),htz1(2),htz2(2),htz3(2),htz4(2),htz5(2),
     #          htz6(2)
*
      data exc2/-0.4999999963d0/,exc4/0.0416666418d0/,
     #     exc6/-0.0013888397d0/,exc8/0.0000247609d0/,
     #     exc10/-0.0000002605d0/
      data alphaf/131.2146d0/
*
      external c02ajf,s09aaf,s07aaf
      external s21bbf,s21caf,s09abf
*
*-----the order of integration is:
*     u, v, m_-^2, m_+^2, M_0^2, m_0^2, m^2, t_w, t_1
*    
*     m_{+/-}^2   transformed for the resonating peaks
*     M_0^2,m_0^2 transformed for the resonating peaks
*     m^2 and t_1 transformed for the jacobian peaks
*
      do ix=1,2
           do it=1,2
                do itt=1,2
                      do il=1,3
                           dpxs(ix,it,itt,il)= 0.d0
                      enddo
                enddo
           enddo
      enddo       
      do it=1,2
           do il=1,3
                cpxs(it,il)= 0.d0
                bpxs(it,il)= 0.d0
           enddo
      enddo       
*
      if(ndim.eq.2) then
         uvx= x(1)
         vvx= x(2)
      else if(ndim.eq.6) then
         if(itc.eq.10) then
            smx= x(1)
            spx= x(2)
            sux= x(3)
            sdx= x(4)
            sfx= x(5)
            twx= x(6)
         else if(itc.eq.7) then
            if(itcc.eq.1) then
               smx= x(1)
               sux= x(2)
               sdx= x(3)
               sfx= x(4)
               twx= x(5)
               t1x= x(6)
            else if(itcc.eq.2) then
               smx= x(1)
               spx= x(2)
               sux= x(3)
               sfx= x(4)
               twx= x(5)
               t1x= x(6)
            else if(itcc.eq.3) then
               smx= x(1)
               spx= x(2)
               sux= x(3)
               sdx= x(4)
               twx= x(5)
               t1x= x(6)
            endif
         else
            smx= x(1)
            sux= x(2)
            sdx= x(3)
            sfx= x(4)
            twx= x(5)
            t1x= x(6)
         endif
      else if(ndim.eq.8) then
         if(itc.eq.10) then
            uvx= x(1)
            vvx= x(2)
            smx= x(3)
            spx= x(4)
            sux= x(5)
            sdx= x(6)
            sfx= x(7)
            twx= x(8)
         else if(itc.eq.7) then
            if(itcc.eq.1) then
               uvx= x(1)
               vvx= x(2)
               smx= x(3)
               sux= x(4)
               sdx= x(5)
               sfx= x(6)
               twx= x(7)
               t1x= x(8)
            else if(itcc.eq.2) then
               uvx= x(1)
               vvx= x(2)
               smx= x(3)
               spx= x(4)
               sux= x(5)
               sfx= x(6)
               twx= x(7)
               t1x= x(8)
            else if(itcc.eq.3) then
               uvx= x(1)
               vvx= x(2)
               smx= x(3)
               spx= x(4)
               sux= x(5)
               sdx= x(6)
               twx= x(7)
               t1x= x(8)
            endif
         else if(itc.eq.9) then
            uvx= x(1)
            vvx= x(2)
            smx= x(3)
            sux= x(4)
            sdx= x(5)
            sfx= x(6)
            twx= x(7)
            t1x= x(8)
         else if(itc.eq.12) then
            uvx= x(1)
            vvx= x(2)
            spx= x(3)
            sux= x(4)
            sdx= x(5)
            sfx= x(6)
            twx= x(7)
            t1x= x(8)
         endif
      else if(ndim.eq.7) then
         if(itc.eq.11) then
            uvx= x(1)
            vvx= x(2)
            sux= x(3)
            sdx= x(4)
            sfx= x(5)
            twx= x(6)
            t1x= x(7)
         else
            smx= x(1)
            spx= x(2)
            sux= x(3)
            sdx= x(4)
            sfx= x(5)
            twx= x(6)
            t1x= x(7)
         endif
      else if(ndim.eq.9) then
         uvx= x(1)
         vvx= x(2)
         smx= x(3)
         spx= x(4)
         sux= x(5)
         sdx= x(6)
         sfx= x(7)
         twx= x(8)
         t1x= x(9)
      endif
*
      if(omdist.eq.'y') then
         itc= 13
      endif
*
      ik= ik+1
      rs= ars
      one= 1.d0
      if(rio.eq.'a') then
         co(1)= 1.d0
      else if(rio.eq.'i') then
         co(1)= 0.d0
      endif
      co(2)= 0.d0
      apis= 16.d0*pis
      swis= sw(2)*sw(2)
      srwis= rsw(2)*rsw(2)
      srzis= rsz(2)*rsz(2)
      aswi= abs(rsw(2))
      wm2= wm*wm
      zm2= zm*zm
      ccz= gf*zm2/pis
      ccw= gf*wm2/pis
      if(oww.eq.'i') then
         frwm2= rwm2-rwg*rwg
      else if(oww.eq.'f') then
         frwm2= rwm2
      endif
      if(ozz.eq.'i') then
         frzm2= rzm2-rzg*rzg
      else if(ozz.eq.'f') then
         frzm2= rzm2
      endif
      rwmgs= rwmg*rwmg
      if(rio.eq.'a') then
         ali= alphai
      else if(rio.eq.'i') then
         ali= alphaf
      endif
      opeakas= 'l'
*      opeakas= 'i'
*
*-----if a point is not allowed then the
*     result is set to zero
*
      iz= 1
*
      if(ndim.eq.6.or.ndim.eq.7) then
         ueps= 0.d0
         uv= 1.d0
         uvs= uv*uv
         ujc= 1.d0
         veps= 0.d0
         vv= 1.d0
         vjc= 1.d0
      else if(ndim.eq.2) then
         ul0= 1.d0-omul
         qp2s= arrinv(8)
         qp4s= arrinv(10)
         sp2s= arrinv(2)+arrinv(4)+arrinv(5)
         sp4s= arrinv(1)+arrinv(3)+arrinv(5)
*
         ul1= 2.d0*(qp2s+sp2s)
         ul2= 2.d0*(qp4s+sp4s)
         sa1= (arrinv(1)+arrinv(4)+arrinv(5))/arrinv(7)
         sa3= (arrinv(2)+arrinv(3)+arrinv(5))/arrinv(9)
         samin= dmin1(sa1,sa3)
         v01= sqrt(2.d0*arrinv(1))+sqrt(2.d0*arrinv(2))
         v01= v01*v01
         v02= sqrt(2.d0*arrinv(3))+sqrt(2.d0*arrinv(4))
         v02= v02*v02
         v03= sqrt(2.d0*arrinv(5))+sqrt(2.d0*arrinv(6))
         v03= v03*v03
         v00= dmax1(v01,v02,v03)
         ul3= v00/samin
         ul4= 2.d0/samin*(sp2s+samin*qp2s)
         ul5= 2.d0/samin*(sp4s+samin*qp4s)
         ul6= 2.d0*(sp2s+samin*qp2s)/(samin+2.d0*qp2s)
         ul7= 2.d0*(sp4s+samin*qp4s)/(samin+2.d0*qp4s)
         ul8= v00
         ai1= arrinv(1)
         ai2= arrinv(2)
         ai3= arrinv(3)
         ai4= arrinv(4)
         ai5= arrinv(5)
         ai6= arrinv(6)
         ai7= arrinv(7)
         ai8= arrinv(8)
         ai45= ai4+ai5
         ai245= ai2+ai45
         ai1s= ai1*ai1
         ai2s= ai2*ai2
         ai3s= ai3*ai3
         ai4s= ai4*ai4
         ai5s= ai5*ai5
         ai5c= ai5s*ai5
         ai5f= ai5c*ai5
         ul9= 2.d0*(ai7*ai245/ai45+ai8)
*
         ulo= dmax1(ul0,ul1,ul2,ul3,ul4,ul5,ul6,ul7,ul8,ul9)
         omulo= 1.d0-ulo
         if(omulo.lt.0.d0) then
            iz= 0
            ifz(1)= ifz(1)+1
            go to 1
         endif
*
         ueps= omulo*(1.d0-uvx)**hbeti
         uv= 1.d0-ueps
         ujc= omulo**hbet
         uvs= uv*uv
*
         if(iac(3).eq.1.and.isab.eq.1) then
            vvl4= ombsa(1)/opbsa(1)*uvs
            vvl= dmax1(vvl1,vvl2,vvl3,vvl4)
         else
            vvl= dmax1(vvl1,vvl2,vvl3)
         endif
         vve= uv*(2.d0*suml-uv)
         vvll= dmax1(vvl,vve)
         vvu1= uv
         if(iac(3).eq.1.and.isaa.eq.1) then
            vvu2= omasa(1)/opasa(1)*uvs
            vvu= dmin1(vvu1,vvu2)
         else
            vvu= uv
         endif
*
         svl1= v00
         svl2= 2.d0*(sp2s-qp2s*uv)/(uv-2.d0*qp2s)*uv
         svl3= 2.d0*(sp4s-qp4s*uv)/(uv-2.d0*qp4s)*uv
         svl4= 2.d0*sp2s/(uv-2.d0*qp2s)*uv
         svl5= 2.d0*sp4s/(uv-2.d0*qp4s)*uv
*
         ifvv= 1
*
         cojca= ai7*ai7
*
         cojcb= 2.d0*uv*ai1*ai7
         cojcb= cojcb+ai1*ai7*ai8*(-4.d0)
         cojcb= cojcb+ai7*ai8*(4.d0*ai45)
         cojcb= cojcb+ai7*ai7*(4.d0*ai245)
         cojcb= -cojcb
*
         cojcc= uv*ai1*ai7*(-4.d0*ai245)
         cojcc= cojcc+uv*ai1*ai8*(4.d0*ai45)
         cojcc= cojcc+uv*ai1*ai1*ai8*(4.d0)
         cojcc= cojcc-uvs*ai1*ai1
         cojcc= cojcc+ai1*ai7*ai8*(-8.d0*ai245)
         cojcc= cojcc+ai1*ai8*ai8*(-8.d0*ai45)
         cojcc= cojcc+ai1*ai1*ai8*ai8*(-4.d0)
         cojcc= cojcc+ai7*ai8*(-8.d0*ai45*ai245)
         cojcc= cojcc+ai7*ai7*(-4.d0*ai245*ai245)
         cojcc= cojcc+ai8*ai8*(-4.d0*ai45*ai45)
         cojcc= -cojcc
*
         call c02ajf(cojca,cojcb,cojcc,bvv1,bvv2,ifvv)
         if(ifvv.ne.0.or.bvv1(2).ne.0.d0) then
            iz= 0
            ifz(1)= ifz(1)+1
            go to 1
         endif
*
         ifvvv= 1
*
         csfjca= 0.125d0*ai5s
*
         csfjcb= 0.5d0*ai5*(ai1*ai2+ai3*ai4)
         csfjcb= csfjcb+0.5d0*ai5s*(ai1+ai2+ai3+ai4)
         csfjcb= csfjcb+0.5d0*ai5c
         csfjcb= -csfjcb
*
         csfjcc= ai5*(-ai1*ai2*ai3-ai1*ai2*ai4-ai1*ai3*ai4-ai1*ai2s-
     #           ai2*ai3*ai4-ai2*ai1s-ai3*ai4s-ai4*ai3s)
         csfjcc= csfjcc+ai5s*(-2.d0*ai1*ai2-ai1*ai3-ai1*ai4-ai2*
     #           ai3-ai2*ai4-2.d0*ai3*ai4-0.5d0*ai1s-0.5d0*ai2s-
     #           0.5d0*ai3s-0.5d0*ai4s)
         csfjcc= csfjcc+ai5c*(-ai1-ai2-ai3-ai4)
         csfjcc= csfjcc-0.5d0*+ai5f
         csfjcc= csfjcc+ai1*ai2*ai3*ai4-0.5d0*ai1s*ai2s-0.5d0*ai3s*
     #           ai4s
         csfjcc= -csfjcc
*
         call c02ajf(csfjca,csfjcb,csfjcc,bvvv1,bvvv2,ifvvv)
         if(ifvvv.ne.0.or.bvvv1(2).ne.0.d0) then
            iz= 0
            ifz(1)= ifz(1)+1
            go to 1
         endif
*
         svl6= bvv1(1)
         svl7= bvvv1(1)
*
         svu1= samin*uv
         svu2= bvv2(1)
         svu3= bvvv2(1)
*
         vvlll= dmax1(vvll,svl1,svl2,svl3,svl4,
     #                svl5,svl6,svl7)
         vvuu= dmin1(vvu,svu1,svu2,svu3)
*
         uvl= uv-vvlll
*
         vkf= (uv-vvuu)/uvl
         if(vkf.lt.0.d0) then
            iz= 0
            ifz(1)= ifz(1)+1
            go to 1
         else if(vkf.eq.0.d0) then
            if(vvx.gt.1.d0) then
               iz= 0
               ifz(1)= ifz(1)+1
               go to 1
            else if(vvx.eq.1.d0) then
               veps= 0.d0
            else
               veps= uvl*(1.d0-vvx)**hbeti
            endif
            avkf= 1.d0
         else
            veps= uvl*(1.d0-(1.d0-vkf**hbet)*vvx)**hbeti
            avkf= 1.d0-vkf**hbet
         endif
         vv= uv-veps
         vjc0= 1.d0-vvlll/uv
         if(vjc0.le.0.d0) then
            iz= 0
            ifz(1)= ifz(1)+1
            go to 1
         else
            vjc= vjc0**hbet*avkf
         endif
*
      else if(ndim.eq.8.or.ndim.eq.9) then
*
*-----independent invariants are initialized
*     first u and v variable
*
         if(uvx.gt.1.d0) then
            iz= 0
            ifz(1)= ifz(1)+1
            go to 1
         endif
         ueps= omul*(1.d0-uvx)**hbeti
         uv= 1.d0-ueps
         ujc= omul**hbet
         uvs= uv*uv
*
*-----limits for v
*
*-----from equal cuts on S
*
         if(iac(3).eq.1.and.isab.eq.1) then
            vvl4= ombsa(1)/opbsa(1)*uvs
            vvl= dmax1(vvl1,vvl2,vvl3,vvl4)
         else
            vvl= dmax1(vvl1,vvl2,vvl3)
         endif
*
*-----from E
*
         vve= uv*(2.d0*suml-uv)
         vvll= dmax1(vvl,vve)
*
         vvu1= uv
         if(iac(3).eq.1.and.isaa.eq.1) then
            vvu2= omasa(1)/opasa(1)*uvs
            vvu= dmin1(vvu1,vvu2)
         else
            vvu= uv
         endif
         uvl= uv-vvll
*
         vkf= (uv-vvu)/uvl
         if(vkf.lt.0.d0) then
            iz= 0
            ifz(1)= ifz(1)+1
            go to 1
         else if(vkf.eq.0.d0) then
            if(vvx.gt.1.d0) then
               iz= 0
               ifz(1)= ifz(1)+1
               go to 1
            else if(vvx.eq.1.d0) then
               veps= 0.d0
            else
               veps= uvl*(1.d0-vvx)**hbeti
            endif
            avkf= 1.d0
         else
            veps= uvl*(1.d0-(1.d0-vkf**hbet)*vvx)**hbeti
            avkf= 1.d0-vkf**hbet
         endif
         vv= uv-veps
         vjc0= 1.d0-vvll/uv
         if(vjc0.le.0.d0) then
            iz= 0
            ifz(1)= ifz(1)+1
            go to 1
         else
            vjc= vjc0**hbet*avkf
         endif
      endif
*
      rit= itcn*1.d0
      if(itc.ne.1) then
         ajc= 1.d0
      else
         ajc= ((ueps*(1.d0-ueps)+veps)/uv)**itcn
      endif 
*
      if(vv.lt.0.d0) then
         iz= 0
         ifz(1)= ifz(1)+1
         go to 1
      endif
      svv= sqrt(vv)
      if(ofl.eq.'c') then
         vwmg= aswi*vv
      else
         vwmg= rwmg*vv
      endif
      vvs= vv*vv
      xm= uv
      xp= vv/uv  
      xmop= xm/xp
      if(ndim.eq.7.or.ndim.eq.6) then
         xdf= 0.d0
      else
         xdf= (ueps*(1.d0-ueps)-veps)/uv
      endif
      xdfs= xdf*xdf
      sh= vv*s
      rmu2= em2/sh
      rmu2s= rmu2*rmu2
      rmu2c= rmu2s*rmu2
      rswrv= rsw(1)/vv
      rswiv= rsw(2)/vv
      rszrv= rsz(1)/vv
      rsziv= rsz(2)/vv
*
*-----Z parameters
*
      rszm2= zm*zm/sh
*
*-----Z propagator (real part and imaginary part)
*
      if(ofl.eq.'c') then
         call wtopolez0(pggf0,fw0)
         p2r= -zm2
         p2i= 0.d0
         call wtopoleg(p2r,p2i,pggfzm,pgglqzm,pggnpzm)
         arezm= ali-0.25d0*(pggfzm(1)-pggf0+pggnpzm)/pi
         aizm= -0.25d0*(pggfzm(2)+pgglqzm(2))/pi
         frszm2= rszrv
         dz0= 1.d0-frszm2
         dz= dz0*dz0+srzis/vvs
         rz0= dz0/dz
         aimz0= rsziv/dz
         trzg= 0.d0
         trgz= 0.d0
         trgg= 0.d0
         p2r= -wm2
         p2i= 0.d0
         call wtopole(p2r,p2i,p3qw,fzw,fw)
         p2r= -sh
         p2i= 0.d0
         call wtopole(p2r,p2i,p3qs,fzs,fws)
         xgs0= 1.d0/8.d0/gf/wm2
         xgsr= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+
     #         p3qw(1)-p3qs(1))
         xgsi= -0.5d0*ccw*p3qs(2)
         agrs= xgs0*xgsr
         agis= xgs0*xgsi
         gms= agrs*agrs+agis*agis
         grs= agrs/gms
         gis= -agis/gms
         call wtopoleg(p2r,p2i,pggfs,pgglqs,pggnps)
         ares= arezm+0.25d0*(pggfzm(1)+pgglqzm(1)-
     #          pggfs(1)-pgglqs(1))/pi
         ais= aizm+0.25d0*(pggfzm(2)+pgglqzm(2)-
     #          pggfs(2)-pgglqs(2))/pi
         ems= ares*ares+ais*ais
         ers= 4.d0*pi*ares/ems
         eis= -4.d0*pi*ais/ems
         strrs= ers*agrs-eis*agis
         stris= ers*agis+eis*agrs
         tstrrs= 2.d0*strrs
         tstris= 2.d0*stris
*
         p2r= -sw(1)
         p2i= -sw(2)
         call wtopole(p2r,p2i,p3qsw,fzsw,fwsw)
         xgsw0= 1.d0/8.d0/gf/wm2
         xgswr= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+
     #          p3qw(1)-p3qsw(1))
         xgswi= -0.5d0*ccw*p3qsw(2)
         agrsw= xgsw0*xgswr
         agisw= xgsw0*xgswi
         agmsw= agrsw*agrsw+agisw*agisw
         grsw= agrsw/agmsw
         gisw= -agisw/agmsw
*
         p2r= -sz(1)
         p2i= -sz(2)
         call wtopole(p2r,p2i,p3qsz,fzsz,fwsz)
         xgsz0= 1.d0/8.d0/gf/wm2
         xgszr= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+
     #          p3qw(1)-p3qsz(1))
         xgszi= -0.5d0*ccw*p3qsz(2)
         agrsz= xgsz0*xgszr
         agisz= xgsz0*xgszi
         agmsz= agrsz*agrsz+agisz*agisz
         grsz= agrsz/agmsz
         gisz= -agisz/agmsz
*
         call wtopoleg(p2r,p2i,pggfsz,pgglqsz,pggnpsz)
         aresz= arezm+0.25d0*(pggfzm(1)+pgglqzm(1)-
     #          pggfsz(1)-pgglqsz(1))/pi
         aisz= aizm+0.25d0*(pggfzm(2)+pgglqzm(2)-
     #          pggfsz(2)-pgglqsz(2))/pi
         ermz= aresz*aresz+aisz*aisz
         ersz= 4.d0*pi*aresz/ermz
         eisz= -4.d0*pi*aisz/ermz
         gmsz= grsz*grsz+gisz*gisz
         strrsz= ersz*agrsz-eisz*agisz
         strisz= ersz*agisz+eisz*agrsz
         ctrrs= 1.d0-strrs
         ctris= -stris
         ctrrsz= 1.d0-strrsz
         ctrisz= -strisz
         ctrms= ctrrs*ctrrs+ctris*ctris
         ctrrsi= ctrrs/ctrms
         ctrisi= -ctris/ctrms
         ttrrs= strrs*ctrrsi-stris*ctrisi
         ttris= strrs*ctrisi+stris*ctrrsi
         prsr= sh-sz(1)
         prsi= -sz(2)
         prsm= prsr*prsr+prsi*prsi
         prsri= prsr/prsm
         prsii= -prsi/prsm
         ratgr= grs*agrsz-gis*agisz
         ratgi= grs*agisz+gis*agrsz
         ratcr= ctrrsz*ctrrsi-ctrisz*ctrisi
         ratci= ctrrsz*ctrisi+ctrisz*ctrrsi
         ratgcr= grs*ctrrsi-gis*ctrisi
         ratgci= grs*ctrisi+gis*ctrrsi
         ratr= 1.d0-ratgr*ratcr+ratgi*ratci
         rati= -ratgr*ratci-ratgi*ratcr
         arhrs= sh-sz(1)+ratr*sz(1)-rati*sz(2)+(ratgcr*(fzs(1)-
     #          fzsz(1))-ratgci*(fzs(2)-fzsz(2)))/apis
         arhis= -sz(2)+ratr*sz(2)+rati*sz(1)+(ratgcr*(fzs(2)-
     #          fzsz(2))+ratgci*(fzs(1)-fzsz(1)))/apis
         brhrs= arhrs*prsri-arhis*prsii
         brhis= arhrs*prsii+arhis*prsri
         brhms= brhrs*brhrs+brhis*brhis
         rhrs= brhrs/brhms
         rhis= -brhis/brhms
         rz= rz0*rhrs-aimz0*rhis
         aimz= rz0*rhis+aimz0*rhrs
         omrz= 1.d0-rz
      else if(ofl.eq.'a') then
         trzg= 0.d0
         trgz= 0.d0
         trgg= 0.d0
         if(ozz.eq.'r') then
            dz0= 1.d0-rszm2
            dz= dz0*dz0+rszw2
            rz= dz0/dz
            omrz= (-rszm2*dz0+rszw2)/dz
            aimz= -rszw/dz
            haimz= scth2*aimz
         else
            frszm2= frzm2/vv
            dz0= 1.d0-frszm2
            dz= dz0*dz0+rzmg*rzmg/vvs
            rz= dz0/dz
            omrz= (-frszm2*dz0+rzmg*rzmg/vvs)/dz
            aimz= -rzmg/vv/dz
            haimz= scth2*aimz
         endif
         grs= 1.d0
         gis= 0.d0
         strrs= sth2
         stris= 0.d0
         ctrrs= 1.d0-strrs
         ctris= -stris
         tstrrs= 2.d0*strrs
         tstris= 2.d0*stris
         ctrms= ctrrs*ctrrs+ctris*ctris
         ctrrsi= ctrrs/ctrms
         ctrisi= -ctris/ctrms
         ttrrs= strrs*ctrrsi-stris*ctrisi
         ttris= strrs*ctrisi+stris*ctrrsi
         rhrs= 1.d0
         rhis= 0.d0
      else
          trzg= 0.d0
          trgz= 0.d0
          trgg= 0.d0
          if(ozz.eq.'r') then
             dz0= 1.d0-rszm2
             dz= dz0*dz0+rszw2
             rz= dz0/dz
             omrz= (-rszm2*dz0+rszw2)/dz
             aimz= -rszw/dz
             haimz= scth2*aimz
          else
             frszm2= frzm2/vv
             dz0= 1.d0-frszm2
             dz= dz0*dz0+rzmg*rzmg/vvs
             rz= dz0/dz
             omrz= (-frszm2*dz0+rzmg*rzmg/vvs)/dz
             aimz= -rzmg/vv/dz
             haimz= scth2*aimz
          endif
      endif
*
*-----Reduced structure functions are computed with arguments xp,xm
*
      opxp= 1.d0+xp
      opxm= 1.d0+xm
      omxp= veps/uv
      omxm= ueps
      if(isf.eq.0) then
         stfp= 1.d0
         stfm= 1.d0
      else if(isf.gt.0) then
         if(omxp.eq.0) then
            stfp= d0gl
         else
            rcpx= 0.25d0*opxp*opxp
            rcpy= xp
            iflp= 1
            rclp= s21baf(rcpx,rcpy,iflp)
            stfp= d0gl+eob*omxp**omhb*(-0.5d0*opxp+
     #            feta*(-4.d0*opxp*log(omxp)+
     #            3.d0*opxp*log(xp)+4.d0*rclp-5.d0-xp))
         endif
         if(omxm.eq.0) then
            stfm= d0gl
         else
            rcmx= 0.25d0*opxm*opxm
            rcmy= xm
            iflm= 1
            rclm= s21baf(rcmx,rcmy,iflm)
            stfm= d0gl+eob*omxm**omhb*(-0.5d0*opxm+
     #            feta*(-4.d0*opxm*log(omxm)+
     #            3.d0*opxm*log(xm)+4.d0*rclm-5.d0-xm))
         endif
      endif
*
      stf= stfp*stfm
*
*-----if there is no upper cut on some FS IM, then the maximum is allowed
*
      do j=1,6
          if(rr(j).eq.1.d0) then
             rrr(j)= rr(j)
          else
             rrr(j)= rr(j)/vv
          endif
          rrl(j)= rl(j)/vv
          srrl(j)= srl(j)/svv
      enddo
*
*-----cuts become special near xp = xm
*
      if(abs(xdf).gt.1.d-15) then
         ieq= 1
         bxe= vv/(ueps*(1.d0-ueps)-veps)
         if(xdf.gt.0.d0) then
            enc= 1.d0
         else if(xdf.lt.0.d0) then
            enc= xmop
         endif
      else
         ieq= 0
         bxe= 1.d0
      endif
      if(ieq.eq.0.and.xm.le.teq) then
         iz= 0
         ifz(1)= ifz(1)+1
         go to 1
      endif
*
      if(ieq.eq.0.and.iac(2).ne.0.and.iac(4).ne.0) then
         sct12= sct120/vv
         sct13= sct130/vv
         sct14= sct140/vv
         sct23= sct230/vv
         sct24= sct240/vv
         sct34= sct340/vv
      else
         sct12= 0.d0
         sct13= 0.d0
         sct14= 0.d0
         sct23= 0.d0
         sct24= 0.d0
         sct34= 0.d0
      endif
*          
*-----cuts on E
*
      do j=1,4
          if(ieq.eq.1) then
             bl(j)= 2.d0*rae(j)/xdf
             xbl(j)= 2.d0*rae(j)/xp
          else if(ieq.eq.0) then
             bl(j)= 2.d0*rae(j)/xm
          endif
      enddo
*
*-----cuts on S
*
      if(iac(3).ne.0) then
         do j=1,4
             if(cgam(j).eq.0.d0) then
                ss(j)= 0.d0
             else
                ss(j)= 1.d0+(1.d0-cgam(j))/cgam(j)*xmop
                ss(j)= 1.d0/ss(j)
             endif
             if(sgam(j).eq.0.d0) then
                cs(j)= 1.d0
             else
                cs(j)= 1.d0+(1.d0-sgam(j))/sgam(j)*xmop
                cs(j)= 1.d0/cs(j)
             endif
         enddo
      endif
*
*-----initialization of sm = m_-^2
*
      zma1= dsm
      zma2= vv*sct12
      zmb1= usm
      zmb2= (svv-sdsp)*(svv-sdsp)
      zmb3= vv*(1.d0-sqrt(sct34))*(1.d0-sqrt(sct34))
      if(ieq.eq.0) then
         zma3= vv*(bl(1)+bl(2)-1.d0)
         zmb4= vv*(1.d0-0.5d0*(bl(3)+bl(4)))*
     #         (1.d0-0.5d0*(bl(3)+bl(4)))
         zmb5= vv*(1.d0-bl(3))
         zmb6= vv*(1.d0-bl(4))
      else if(ieq.eq.1) then
         zma3= vv*(-enc+xbl(1)+xbl(2))
         zmb4= 0.25d0*vv*(1.d0+enc-xbl(3)-xbl(4))*
     #         (1.d0+enc-xbl(3)-xbl(4))
         zmb5= vv*(enc-xbl(3))
         zmb6= vv*(enc-xbl(4))
      endif
      xzma= dmax1(zma1,zma2,zma3)
      xzmb= dmin1(zmb1,zmb2,zmb3,zmb4,zmb5,zmb6)
*
*-----limits on sm from cuts on S. Here for maximum security. Rare
*
      if(iac(3).eq.0) then
         zma= xzma
         zmb= xzmb
      else 
         if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then 
            if(ss(3).eq.ss(1)) then
               szma= xzma
               szmb= xzmb
            else if(ss(3).gt.ss(1)) then
               szmb= xzmb
               adsp= dsp/vv
               axszma= dmax1(adsp,sct34)
               axszma= vv*(axszma-(1.d0-ss(1)-ss(3))/
     #                 (ss(3)-ss(1)))
               szma= dmax1(axszma,xzma)
            else if(ss(3).lt.ss(1)) then
               if(ss(3).lt.0.5d0) then
                  szma= xzma
                  axszmb= vv*((ss(3)-0.5d0)/(ss(3)-ss(1)))**2
                  szmb= dmin1(axszmb,xzmb)
               else
                  iz= 0
                  ifz(2)= ifz(2)+1
                  go to 1
               endif
            endif
         else
            szma= xzma
            szmb= xzmb
         endif
         if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then 
            if(cs(3).eq.cs(1)) then
               zma= szma
               zmb= szmb
            else if(cs(3).gt.cs(1)) then
               if(cs(3).gt.0.5d0) then
                  zma= szma
                  axczmb= vv*((cs(3)-0.5d0)/(cs(3)-cs(1)))**2
                  zmb= dmin1(axczmb,szmb)
               else
                  iz= 0
                  ifz(3)= ifz(3)+1
                  go to 1
               endif
            else if(cs(3).lt.cs(1)) then
                  zmb= szmb
                  adsp= dsp/vv
                  axczma= dmax1(adsp,sct34)
                  axczma= vv*(axczma-(1.d0-cs(1)-cs(3))/
     #                    (cs(3)-cs(1)))
                  zma= dmax1(axczma,szma)
            endif
         else
            zma= szma
            zmb= szmb
         endif
      endif
*
      if(obin.eq.'p') then
         dzmb= bbp*bbp
         zmb= dmin1(zmb,dzmb)
      else if(obin.eq.'m'.and.abm.gt.0.d0) then
         dzma= abm*abm
         zma= dmax1(zma,dzma)
      endif
*
      if(itc.ge.7.and.itc.lt.10) then
         dzpa= dmax1(dsp,sct340)
         if(itc.eq.7.and.itcc.eq.1) then
            dzmb= (dist/rs-sqrt(dzpa))*(dist/rs-sqrt(dzpa))
            zmb= dmin1(zmb,dzmb)
         else if(itc.eq.8) then
            dzma= (dist/rs+sqrt(dzpa))*(dist/rs+sqrt(dzpa))
            zma= dmax1(zma,dzma)
            dzmb= 0.25d0*(svv+dist/rs)*(svv+dist/rs)
            zmb= dmin1(zmb,dzmb)
         else if(itc.eq.9) then
            dzmb= (svv-dist/rs)*(svv-dist/rs)
            zmb= dmin1(zmb,dzmb)
         endif
      endif 
      if(itc.eq.7.and.itcc.eq.3) then
         zmbd3= vv-0.5d0*dist*dist/s
         zmb= dmin1(zmb,zmbd3)
      endif
      if(itc.eq.11) then
         zmbd3= vv-0.5d0*distp*distp/s
         zmb= dmin1(zmb,zmbd3)
      endif
*
*-----test on sm
*
      if(zmb.le.zma) then
         iz= 0
         ifz(4)= ifz(4)+1
         go to 1
      endif
*
      if(itc.ge.11) then
       if(itc.eq.11) then
          bdistl= distm*distm/s-zma
          bdistu= zmb-distm*distm/s
       else if(itc.eq.12) then
          bdistl= dist*dist/s-zma
          bdistu= zmb-dist*dist/s
       else if(itc.eq.13) then
          bdistl= 2.d0*arrinv(1)-zma
          bdistu= zmb-arrinv(1)
       endif
       if(bdistl.le.0.d0.or.bdistu.le.0.d0) then
          iz= 0
          ifz(4)= ifz(4)+1
          go to 1
       endif
       if(itc.eq.11) then
         sm= (distm/rs/svv)**2
         if(oww.eq.'r') then
            pmjac= 2.d0*distm/s/((vv*sm-rwm2)**2+
     #             (vv*sm*swg)**2)
         else if(oww.eq.'f'.or.oww.eq.'i') then
            pmjac= 2.d0*distm/s/((vv*sm-frwm2)**2+
     #             rwmgs)
         endif
       else if(itc.eq.12) then
         sm= (dist/rs/svv)**2
         if(oww.eq.'r') then
            pmjac= 2.d0*dist/s/((vv*sm-rwm2)**2+
     #             (vv*sm*swg)**2)
         else if(oww.eq.'f'.or.oww.eq.'i') then
            pmjac= 2.d0*dist/s/((vv*sm-frwm2)**2+
     #             rwmgs)
         endif
       else if(itc.eq.13) then
         sm= 2.d0*arrinv(1)/vv
         if(oww.eq.'r') then
            pmjac= 2.d0/s/((vv*sm-rwm2)**2+(vv*sm*swg)**2)
         else if(oww.eq.'f'.or.oww.eq.'i') then
            pmjac= 2.d0/s/((vv*sm-frwm2)**2+rwmgs)
         endif
       endif
       smjc= 1.d0
      else
         if(opeak.eq.'y') then
            if(ofl.eq.'c') then
               zmas= zma-rsw(1)
               zmbs= zmb-rsw(1)
               atma= zmas/aswi
               atmb= zmbs/aswi
            else
               if(oww.eq.'r') then
                  zmas= zma-rwm2
                  zmbs= zmb-rwm2
                  atma= (zmas+swgs*zma)/rwmg
                  atmb= (zmbs+swgs*zmb)/rwmg
               else if(oww.eq.'f'.or.oww.eq.'i') then
                  zmas= zma-frwm2
                  zmbs= zmb-frwm2
                  atma= zmas/rwmg
                  atmb= zmbs/rwmg
               endif
            endif
            if(atma.gt.1.d0.and.atmb.gt.1.d0) then
               atma= 1.d0/atma
               atma= atan(atma)
               zmat= (pih-atma)/vwmg
               atmb= 1.d0/atmb
               atmb= atan(atmb)
               zmbt= (pih-atmb)/vwmg
               smjc0= (-atmb+atma)/vwmg
            else if(atma.gt.1.d0.and.atmb.lt.-1.d0) then
               atma= 1.d0/atma
               atma= atan(atma)
               zmat= (pih-atma)/vwmg
               atmb= -1.d0/atmb
               atmb= atan(atmb)
               zmbt= (-pih+atmb)/vwmg
               smjc0= (-pi+atmb+atma)/vwmg
            else if(atma.gt.1.d0.and.abs(atmb).lt.1.d0) then
               atma= 1.d0/atma
               atma= atan(atma)
               zmat= (pih-atma)/vwmg
               atmb= atan(atmb)
               zmbt= atmb/vwmg
               smjc0= (-pih+atmb+atma)/vwmg
            else if(atma.lt.-1.d0.and.atmb.gt.1.d0) then
               atma= -1.d0/atma
               atma= atan(atma)
               zmat= (-pih+atma)/vwmg
               atmb= 1.d0/atmb
               atmb= atan(atmb)
               zmbt= (pih-atmb)/vwmg
               smjc0= (pi-atmb-atma)/vwmg
            else if(atma.lt.-1.d0.and.atmb.lt.-1.d0) then
               atma= -1.d0/atma
               atma= atan(atma)
               zmat= (-pih+atma)/vwmg
               atmb= -1.d0/atmb
               atmb= atan(atmb)
               zmbt= (-pih+atmb)/vwmg
               smjc0= (atmb-atma)/vwmg
            else if(atma.lt.-1.d0.and.abs(atmb).lt.1.d0) then
               atma= -1.d0/atma
               atma= atan(atma)
               zmat= (-pih+atma)/vwmg
               atmb= atan(atmb)
               zmbt= atmb/vwmg
               smjc0= (pih+atmb-atma)/vwmg
            else if(abs(atma).lt.1.d0.and.atmb.gt.1.d0) then
               atma= atan(atma)
               zmat= atma/vwmg
               atmb= 1.d0/atmb
               atmb= atan(atmb)
               zmbt= (pih-atmb)/vwmg
               smjc0= (pih-atmb-atma)/vwmg
            else if(abs(atma).lt.1.d0.and.atmb.lt.-1.d0) then
               atma= atan(atma)
               zmat= atma/vwmg
               atmb= -1.d0/atmb
               atmb= atan(atmb)
               zmbt= (-pih+atmb)/vwmg
               smjc0= (-pih+atmb-atma)/vwmg
            else if(abs(atma).lt.1.d0.and.abs(atmb).lt.1.d0) then
               atma= atan(atma)
               zmat= atma/vwmg
               atmb= atan(atmb)
               zmbt= atmb/vwmg
               smjc0= (atmb-atma)/vwmg
            endif
*
            zmv= smjc0*smx+zmat
            iftn= 1
            atnm= vwmg*zmv
            if(ofl.eq.'c') then
               sm= (rsw(1)+aswi*s07aaf(atnm,iftn))/vv
            else
               if(oww.eq.'r') then
                  sm= s0w/vv*(1.d0+swg*s07aaf(atnm,iftn))
               else if(oww.eq.'f'.or.oww.eq.'i') then
                  sm= (frwm2+rwmg*s07aaf(atnm,iftn))/vv
               endif
            endif
            if(iftn.ne.0) print 300
           pmjac= 1.d0
           smjc= vv*smjc0
*
         else if(opeak.eq.'n') then         
            smjc0= zmb-zma
            sm= (smjc0*smx+zma)/vv
            if(ofl.eq.'c') then
               pmjac= 1.d0/((vv*sm-rsw(1))**2+srwis)
            else
               if(oww.eq.'r') then
                  pmjac= 1.d0/((vv*sm-rwm2)**2+(vv*sm*swg)**2)
               else if(oww.eq.'f'.or.oww.eq.'i') then
                  pmjac= 1.d0/((vv*sm-frwm2)**2+rwmgs)
               endif
            endif
            smjc= smjc0
         endif
*
      endif
      if(sm.lt.0.d0) then
         iz= 0
         ifz(4)= ifz(4)+1
         go to 1
      endif
      ssm= sqrt(sm)
      smh= sm*sh
*
  300 format(/' Unsuccesful call to S07AF ')
*
*-----initialization of sp = m_+^2
*
      zpa1= dsp
      zpb1= usp
      zpb2= vv*(1.d0-ssm)*(1.d0-ssm)
*
*-----limits on sp from cuts on S. Here for maximum security. Rare
*
      if(iac(3).eq.0) then
         zpb= dmin1(zpb1,zpb2)
         zpa= zpa1
      else 
         if(ss(4).eq.ss(3).and.ss(2).eq.ss(1)) then 
            if(ss(3).eq.ss(1)) then
               azpb= dmin1(zpb1,zpb2)
               azpa= zpa1
            else if(ss(3).gt.ss(1)) then
               zpb3= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1)))
               azpb= dmin1(zpb1,zpb2,zpb3)
               azpa= zpa1
            else if(ss(3).lt.ss(1)) then
               azpb= dmin1(zpb1,zpb2)
               zpa2= vv*(sm+(1.d0-ss(1)-ss(3))/(ss(3)-ss(1)))
               azpa= dmax1(zpa1,zpa2)
            endif
         else
            azpa= zpa1
            azpb= dmin1(zpb1,zpb2)
         endif
         if(cs(4).eq.cs(3).and.cs(2).eq.cs(1)) then 
            if(cs(3).eq.cs(1)) then
               zpa= azpa
               zpb= azpb
            else if(cs(3).gt.cs(1)) then
               zpb= azpb
               bzpa= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1)))
               zpa= dmax1(azpa,bzpa)
            else if(cs(3).lt.cs(1)) then
               zpa= azpa
               bzpb= vv*(sm+(1.d0-cs(1)-cs(3))/(cs(3)-cs(1)))
               zpb= dmin1(azpb,bzpb)
            endif
         else
            zpa= azpa
            zpb= azpb
         endif
      endif
*
      if(ieq.eq.0) then
         zpel= vv*(-1.d0+bl(3)+bl(4)+sm)
         zpeu1= vv*(1.d0-bl(1)-bl(2)+sm)
         zpeu2= vv*(1.d0-bl(1))
         zpeu3= vv*(1.d0-bl(2))
      else if(ieq.eq.1) then
         zpel= vv*(sm-enc+xbl(3)+xbl(4))
         zpeu1= vv*(sm+enc-xbl(1)-xbl(2))
         zpeu2= vv*(enc-xbl(1))
         zpeu3= vv*(enc-xbl(2))
      endif
      zpa= dmax1(zpa,zpel)
      zpb= dmin1(zpb,zpeu1,zpeu2,zpeu3)
      zpap= vv*sct34
      zpa= dmax1(zpa,zpap)
*
      if(obin.eq.'p') then
         tstm= sqrt(vv*sm)
         if(tstm.lt.abp) then
           dzpa= (abp-tstm)*(abp-tstm)
           dzpb= (bbp-tstm)*(bbp-tstm)
           zpa= dmax1(zpa,dzpa)
           zpb= dmin1(zpb,dzpb)
         else
           dzpb= (bbp-tstm)*(bbp-tstm)
           zpb= dmin1(zpb,dzpb)
         endif
      else if(obin.eq.'m') then
         tstm= sqrt(vv*sm)
         if(tstm.gt.bbm) then
           dzpa= (tstm-bbm)*(tstm-bbm)
           dzpb= (tstm-abm)*(tstm-abm)
           zpa= dmax1(zpa,dzpa)
           zpb= dmin1(zpb,dzpb)
         else
           dzpb= (tstm-abm)*(tstm-abm)
           zpb= dmin1(zpb,dzpb)
         endif
      endif
      if(itc.eq.7.and.itcc.eq.3) then
         zpbd3= vv*(1.d0-sm)-0.5d0*dist*dist/s
         zpb= dmin1(zpb,zpbd3)
      endif
*
*-----test on sp
*
      if(zpb.le.zpa) then
         iz= 0
         ifz(5)= ifz(5)+1
         go to 1
      endif
*
      if((itc.eq.7.and.itcc.eq.1).or.(itc.gt.7.and.itc.lt.9)) then
         bdistl= (dist/rs-svv*ssm)*(dist/rs-svv*ssm)-zpa
         bdistu= zpb-(dist/rs-svv*ssm)*(dist/rs-svv*ssm)
         if(bdistl.le.0.d0.or.bdistu.le.0.d0) then
            iz= 0
            ifz(5)= ifz(5)+1
            go to 1
         endif
      else if(itc.eq.9) then
         bdistl= dist*dist/s-zpa
         bdistu= zpb-dist*dist/s
         if(bdistl.le.0.d0.or.bdistu.le.0.d0) then
            iz= 0
            ifz(5)= ifz(5)+1
            go to 1
         endif
      else if(itc.eq.11) then
         bdistl= distp*distp/s-zpa
         bdistu= zpb-distp*distp/s
         if(bdistl.le.0.d0.or.bdistu.le.0.d0) then
            iz= 0
            ifz(5)= ifz(5)+1
            go to 1
         endif
      else if(itc.eq.13) then
         bdistl= 2.d0*arrinv(2)-zpa
         bdistu= zpb-2.d0*arrinv(2)
         if(bdistl.le.0.d0.or.bdistu.le.0.d0) then
            iz= 0
            ifz(5)= ifz(5)+1
            go to 1
         endif
      endif
*
      if((itc.eq.7.and.itcc.eq.1).or.(itc.gt.7.and.itc.lt.9)) then
         sp= (dist/rs/svv-ssm)*(dist/rs/svv-ssm)
         if(oww.eq.'r') then
            ppjac= 2.d0*abs((dist/rs-svv*ssm))/ars/
     #             ((vv*sp-rwm2)**2+(vv*sp*swg)**2)
         else if(oww.eq.'f'.or.oww.eq.'i') then
            ppjac= 2.d0*abs((dist/rs-svv*ssm))/ars/
     #             ((vv*sp-frwm2)**2+rwmgs)
         endif
         spjc= 1.d0
      else if(itc.eq.9) then
         sp= (dist/rs/svv)**2
         if(oww.eq.'r') then
            ppjac= 2.d0*dist/s/((vv*sp-rwm2)**2+
     #             (vv*sp*swg)**2)
         else if(oww.eq.'f'.or.oww.eq.'i') then
            ppjac= 2.d0*dist/s/((vv*sp-frwm2)**2+
     #             rwmgs)
         endif
         spjc= 1.d0
      else if(itc.eq.11) then
         sp= (distp/rs/svv)**2
         if(oww.eq.'r') then
            ppjac= 2.d0*distp/s/((vv*sp-rwm2)**2+
     #             (vv*sp*swg)**2)
         else if(oww.eq.'f'.or.oww.eq.'i') then
            ppjac= 2.d0*distp/s/((vv*sp-frwm2)**2+
     #             rwmgs)
         endif
         spjc= 1.d0
      else if(itc.eq.13) then
         sp= 2.d0*arrinv(2)/vv
         if(oww.eq.'r') then
            ppjac= 2.d0/s/((vv*sp-rwm2)**2+(vv*sp*swg)**2)
         else if(oww.eq.'f'.or.oww.eq.'i') then
            ppjac= 2.d0/s/((vv*sp-frwm2)**2+rwmgs)
         endif
         spjc= 1.d0
      else
         if(opeak.eq.'y') then
            if(ofl.eq.'c') then
               zpas= zpa-rsw(1)
               zpbs= zpb-rsw(1)
               atpa= zpas/aswi
               atpb= zpbs/aswi
            else
               if(oww.eq.'r') then
                  zpas= zpa-rwm2
                  zpbs= zpb-rwm2
                  atpa= (zpas+swgs*zpa)/rwmg
                  atpb= (zpbs+swgs*zpb)/rwmg
               else if(oww.eq.'f'.or.oww.eq.'i') then
                  zpas= zpa-frwm2
                  zpbs= zpb-frwm2
                  atpa= zpas/rwmg
                  atpb= zpbs/rwmg
               endif
            endif
            if(atpa.gt.1.d0.and.atpb.gt.1.d0) then
               atpa= 1.d0/atpa
               atpa= atan(atpa)
               zpat= (pih-atpa)/vwmg
               atpb= 1.d0/atpb
               atpb= atan(atpb)
               zpbt= (pih-atpb)/vwmg
               spjc0= (-atpb+atpa)/vwmg
            else if(atpa.gt.1.d0.and.atpb.lt.-1.d0) then
               atpa= 1.d0/atpa
               atpa= atan(atpa)
               zpat= (pih-atpa)/vwmg
               atpb= -1.d0/atpb
               atpb= atan(atpb)
               zpbt= (-pih+atpb)/vwmg
               spjc0= (-pi+atpb+atpa)/vwmg
            else if(atpa.gt.1.d0.and.abs(atpb).lt.1.d0) then
               atpa= 1.d0/atpa
               atpa= atan(atpa)
               zpat= (pih-atpa)/vwmg
               atpb= atan(atpb)
               zpbt= atpb/vwmg
               spjc0= (-pih+atpb+atpa)/vwmg
            else if(atpa.lt.-1.d0.and.atpb.gt.1.d0) then
               atpa= -1.d0/atpa
               atpa= atan(atpa)
               zpat= (-pih+atpa)/vwmg
               atpb= 1.d0/atpb
               atpb= atan(atpb)
               zpbt= (pih-atpb)/vwmg
               spjc0= (pi-atpb-atpa)/vwmg
            else if(atpa.lt.-1.d0.and.atpb.lt.-1.d0) then
               atpa= -1.d0/atpa
               atpa= atan(atpa)
               zpat= (-pih+atpa)/vwmg
               atpb= -1.d0/atpb
               atpb= atan(atpb)
               zpbt= (-pih+atpb)/vwmg
               spjc0= (atpb-atpa)/vwmg
            else if(atpa.lt.-1.d0.and.abs(atpb).lt.1.d0) then
               atpa= -1.d0/atpa
               atpa= atan(atpa)
               zpat= (-pih+atpa)/vwmg
               atpb= atan(atpb)
               zpbt= atpb/vwmg
               spjc0= (pih+atpb-atpa)/vwmg
            else if(abs(atpa).lt.1.d0.and.atpb.gt.1.d0) then
               atpa= atan(atpa)
               zpat= atpa/vwmg
               atpb= 1.d0/atpb
               atpb= atan(atpb)
               zpbt= (pih-atpb)/vwmg
               spjc0= (pih-atpb-atpa)/vwmg
            else if(abs(atpa).lt.1.d0.and.atpb.lt.-1.d0) then
               atpa= atan(atpa)
               zpat= atpa/vwmg
               atpb= -1.d0/atpb
               atpb= atan(atpb)
               zpbt= (-pih+atpb)/vwmg
               spjc0= (-pih+atpb-atpa)/vwmg
            else if(abs(atpa).lt.1.d0.and.abs(atpb).lt.1.d0) then
               atpa= atan(atpa)
               zpat= atpa/vwmg
               atpb= atan(atpb)
               zpbt= atpb/vwmg
               spjc0= (atpb-atpa)/vwmg
            endif
*
            zpv= spjc0*spx+zpat
            iftn= 1
            atnp= vwmg*zpv
            if(ofl.eq.'c') then
               sp= (rsw(1)+aswi*s07aaf(atnp,iftn))/vv
            else
               if(oww.eq.'r') then
                  sp= s0w/vv*(1.d0+swg*s07aaf(atnp,iftn))
               else if(oww.eq.'f'.or.oww.eq.'i') then
                  sp= (frwm2+rwmg*s07aaf(atnp,iftn))/vv
               endif
            endif
            if(iftn.ne.0) print 300
            ppjac= 1.d0
            spjc= vv*spjc0
*
         else if(opeak.eq.'n') then         
            spjc0= zpb-zpa
            sp= (spjc0*spx+zpa)/vv
            if(ofl.eq.'c') then
               ppjac= 1.d0/((vv*sp-rsw(1))**2+srwis)
            else
               if(oww.eq.'r') then
                  ppjac= 1.d0/((vv*sp-rwm2)**2+(vv*sp*swg)**2)
               else if(oww.eq.'f'.or.oww.eq.'i') then
                  ppjac= 1.d0/((vv*sp-frwm2)**2+rwmgs)
               endif
            endif
            spjc= spjc0
         endif
      endif
      if(sp.lt.0.d0) then
         iz= 0
         ifz(5)= ifz(5)+1
         go to 1
      endif
      ssp= sqrt(sp)
      sph= sp*sh
      spmm= sp-sm
      smmp= sm-sp
*
*-----Fermion Loop, running couplings  scalar form-factors
*
      if(ofl.eq.'c') then
         p2mr= -smh
         p2mi= 0.d0
         call wtopole(p2mr,p2mi,p3qm,fzm,fwsm)
         xgm0= 1.d0/8.d0/gf/wm2
         xgmr= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+p3qw(1)-p3qm(1))
         xgmi= -0.5d0*ccw*p3qm(2)
         agrm= xgm0*xgmr
         agim= xgm0*xgmi
         agmm= agrm*agrm+agim*agim
         grm= agrm/agmm
         gim= -agim/agmm
         p2pr= -sph
         p2pi= 0.d0
         call wtopole(p2pr,p2pi,p3qp,fzp,fwsp)
         xgp0= 1.d0/8.d0/gf/wm2
         xgpr= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+p3qw(1)-p3qp(1))
         xgpi= -0.5d0*ccw*p3qp(2)
         agrp= xgp0*xgpr
         agip= xgp0*xgpi
         agmp= agrp*agrp+agip*agip
         grp= agrp/agmp
         gip= -agip/agmp
         pmr= smh-sw(1)
         ppr= sph-sw(1)
         pmir= pmr/(pmr*pmr+swis)
         pmii= sw(2)/(pmr*pmr+swis)
         ppir= ppr/(ppr*ppr+swis)
         ppii= sw(2)/(ppr*ppr+swis)
         xrhrm= fwsm(1)-fwsw(1)+sw(1)*(p3qsw(1)-p3qm(1))-
     #          sw(2)*(p3qsw(2)-p3qm(2))
         xrhim= fwsm(2)-fwsw(2)+sw(1)*(p3qsw(2)-p3qm(2))+
     #          sw(2)*(p3qsw(1)-p3qm(1))
         arhrm= 1.d0+1.d0/apis*(
     #         pmir*(grm*xrhrm-gim*xrhim)-pmii*(grm*xrhim+gim*xrhrm))
         arhim= 1.d0/apis*(
     #         pmii*(grm*xrhrm-gim*xrhim)+pmir*(grm*xrhim+gim*xrhrm))
         arhmm= arhrm*arhrm+arhim*arhim
         rhrm= arhrm/arhmm
         rhim= -arhim/arhmm
         xrhrp= fwsp(1)-fwsw(1)+sw(1)*(p3qsw(1)-p3qp(1))-
     #          sw(2)*(p3qsw(2)-p3qp(2))
         xrhip= fwsp(2)-fwsw(2)+sw(1)*(p3qsw(2)-p3qp(2))+
     #          sw(2)*(p3qsw(1)-p3qp(1))
         arhrp= 1.d0+1.d0/apis*(
     #         ppir*(grp*xrhrp-gip*xrhip)-ppii*(grp*xrhip+gip*xrhrp))
         arhip= 1.d0/apis*(
     #         ppii*(grp*xrhrp-gip*xrhip)+ppir*(grp*xrhip+gip*xrhrp))
         arhmp= arhrp*arhrp+arhip*arhip
         rhrp= arhrp/arhmp
         rhip= -arhip/arhmp
      else if(ofl.eq.'a') then
         grm= g2
         gim= 0.d0
         grp= g2
         gip= 0.d0
         rhrm= 1.d0
         rhim= 0.d0
         rhrp= 1.d0
         rhip= 0.d0
      endif
*
      if(ofl.eq.'c') then
         jfl= 0
         p1s= -smh
         p2s= -sph
         ps= -sh
         rm12= rnm2
         rm22= rnm2
         rm32= rnm2
         call wtocff(jfl,p1s,p2s,ps,rm12,rm22,rm32,
     #               c00,c01,c02,c03)
         if(jfl.eq.-1) then
            iz= 0
            ifz(5)= ifz(5)+1
            go to 1
         endif
         jfl= 0
         p1s= -smh
         p2s= -sph
         ps= -sh
         rm12= rnm2
         rm22= tqm2
         rm32= rnm2
         call wtocff(jfl,p1s,p2s,ps,rm12,rm22,rm32,
     #               ca0,ca1,ca2,ca3)
         if(jfl.eq.-1) then
            iz= 0
            ifz(5)= ifz(5)+1
            go to 1
         endif
         jfl= 0
         p1s= -smh
         p2s= -sph
         ps= -sh
         rm12= tqm2
         rm22= rnm2
         rm32= tqm2
         call wtocff(jfl,p1s,p2s,ps,rm12,rm22,rm32,
     #               cb0,cb1,cb2,cb3)
         if(jfl.eq.-1) then
            iz= 0
            ifz(5)= ifz(5)+1
            go to 1
         endif
*
         det= -4.d0/((-1.d0+sm+sp)*(-1.d0+sm+sp)-4.d0*sm*sp)
         if(abs(det).gt.1.d9) then
            idt= idt+1
         endif
*
         do i=1,2
          do j=1,6
           cp3(i,j)= ca3(i,j)+2.d0*cb3(i,j)
           cm3(i,j)= ca3(i,j)-2.d0*cb3(i,j)
           cc3(i,j)= cp3(i,j)-3.d0*c03(i,j)
          enddo    
          do j=1,4
           cp2(i,j)= ca2(i,j)+2.d0*cb2(i,j)
           cm2(i,j)= ca2(i,j)-2.d0*cb2(i,j)
           cc2(i,j)= cp2(i,j)-3.d0*c02(i,j)
          enddo    
          do j=1,2
           cp1(i,j)= ca1(i,j)+2.d0*cb1(i,j)
           cm1(i,j)= ca1(i,j)-2.d0*cb1(i,j)
           cc1(i,j)= cp1(i,j)-3.d0*c01(i,j)
          enddo    
          cp0(i)= ca0(i)+2.d0*cb0(i)
          cm0(i)= ca0(i)-2.d0*cb0(i)
          cc0(i)= cp0(i)-3.d0*c00(i)
         enddo
*
         do i=1,2
*
      f1(i)= 16.d0*sph*(c03(i,2)+c03(i,3)-2.d0*c03(i,4))
      f1(i)= f1(i)+16.d0*smh*(-c03(i,1)+2.d0*c03(i,3)-c03(i,4)
     #  -c02(i,1)-c02(i,2)+2.d0*c02(i,3))
      f1(i)= f1(i)+16.d0*sh*(-c03(i,3)+c03(i,4)+c02(i,2)+c01(i,2))
      f1(i)= f1(i)+32.d0*(c03(i,5)-c03(i,6)-c02(i,4))
      f1(i)= f1(i)+32.d0/3.d0*co(i)
*
      f2(i)= 8.d0*sph*(c03(i,2)-c03(i,3)+2.d0*c02(i,2)-
     #  2.d0*c02(i,3))
      f2(i)= f2(i)+8.d0*smh*(c03(i,1)-c03(i,4)+c02(i,1)-c02(i,2))
      f2(i)= f2(i)+8.d0*sh*(c03(i,3)+c03(i,4)+c02(i,2)+2.d0*
     #  c02(i,3)+c01(i,2))
      f2(i)= f2(i)-16.d0*(c03(i,5)+c03(i,6)+c02(i,4))
*
      f3(i)= 8.d0*sph*(-3.d0*c03(i,2)-3.d0*c03(i,3)+6.d0*c03(i,4)
     #  +2.d0*c02(i,2)-2.d0*c02(i,3))
      f3(i)= f3(i)+8.d0*smh*(3.d0*c03(i,1)-6.d0*c03(i,3)+3.d0*
     #  c03(i,4)+5.d0*c02(i,1)+3.d0*c02(i,2)-8.d0*c02(i,3)+2.d0*
     #  c01(i,1)-2.d0*c01(i,2))
      f3(i)= f3(i)+8.d0*sh*(3.d0*c03(i,3)-3.d0*c03(i,4)-3.d0*c02(i,2)
     #  +2.d0*c02(i,3)-c01(i,2))
      f3(i)= f3(i)+16.d0*(-3.d0*c03(i,5)+3.d0*c03(i,6)-c02(i,4))
*
      f4(i)= 64.d0*(c03(i,3)-c03(i,4)-c02(i,2)+c02(i,3))
      f4(i)= sh*f4(i)
*
      ft1(i)= 2.d0*tqm2*(-cp1(i,1)+cp1(i,2)-cp0(i)
     #  +cm1(i,1)-cm1(i,2)+cm0(i))
      ft1(i)= ft1(i)+4.d0*sph*(cc3(i,2)+cc3(i,3)-2.d0*cc3(i,4))
      ft1(i)= ft1(i)+4.d0*smh*(-cc3(i,1)+2.d0*cc3(i,3)-cc3(i,4)
     #  -cc2(i,1)-cc2(i,2)+2.d0*cc2(i,3))
      ft1(i)= ft1(i)+4.d0*sh*(-cc3(i,3)+cc3(i,4)+cc2(i,2)+
     #  cc1(i,2))
      ft1(i)= ft1(i)+8.d0*(cc3(i,5)-cc3(i,6)-cc2(i,4))
*
      ft2(i)= tqm2*(-cp1(i,1)-cp1(i,2)-cp0(i)+
     #  cm1(i,1)+cm1(i,2)+cm0(i))
      ft2(i)= ft2(i)+2.d0*sph*(cc3(i,2)-cc3(i,3)+2.d0*cc2(i,2)-
     #  2.d0*cc2(i,3))
      ft2(i)= ft2(i)+2.d0*smh*(cc3(i,1)-cc3(i,4)+cc2(i,1)-
     #  cc2(i,2))
      ft2(i)= ft2(i)+2.d0*sh*(cc3(i,3)+cc3(i,4)+cc2(i,2)+2.d0*
     #  cc2(i,3)+cc1(i,2))
      ft2(i)= ft2(i)+4.d0*(-cc3(i,5)-cc3(i,6)-cc2(i,4))
*
      ft3(i)= tqm2*(cp1(i,1)-cp1(i,2)+cp0(i)-cm1(i,1)
     #  +cm1(i,2)-cm0(i))
      ft3(i)= ft3(i)+sph*(-6*cc3(i,2)-6*cc3(i,3)+12*cc3(i,4)
     #  +4*cc2(i,2)-4*cc2(i,3))
      ft3(i)= ft3(i)+smh*(6*cc3(i,1)-12*cc3(i,3)+6*cc3(i,4)
     #  +10*cc2(i,1)+6*cc2(i,2)-16*cc2(i,3)+4*cc1(i,1)-4*
     #  cc1(i,2))
      ft3(i)= ft3(i)+sh*(6.d0*(cc3(i,3)-cc3(i,4)-cc2(i,2))+4.d0*
     #  cc2(i,3)-2.d0*cc1(i,2))
      ft3(i)= ft3(i)+4.d0*(-3.d0*cc3(i,5)+3.d0*cc3(i,6)-cc2(i,4))
*
      ft4(i)= 16.d0*(cc3(i,3)-cc3(i,4)-cc2(i,2)+cc2(i,3))
      ft4(i)= sh*ft4(i)
*
      if(rio.eq.'i') then
         ft5(i)= 0.d0
         ft6(i)= 0.d0
      else if(rio.eq.'a') then
*
      ft5(i)= 2.d0*tqm2*(cp1(i,1)-cp1(i,2)+cp0(i)-
     #  cm1(i,1)+cm1(i,2)-cm0(i))
      ft5(i)= ft5(i)+sph*(-4./3.*cp3(i,2)-4./3.*cp3(i,3)+8./
     #  3.*cp3(i,4)-4*cm3(i,2)-4*cm3(i,3)+8*cm3(i,4)+4./3.*
     #  cc3(i,2)+4./3.*cc3(i,3)-8./3.*cc3(i,4))
      ft5(i)= ft5(i)+smh*(4./3.*cp3(i,1)-8./3.*cp3(i,3)+4./3.
     #  *cp3(i,4)+4./3.*cp2(i,1)+4./3.*cp2(i,2)-8./3.*cp2(i,3)
     #  +4*cm3(i,1)-8*cm3(i,3)+4*cm3(i,4)+4*cm2(i,1)+4*cm2(i,2)
     #  -8*cm2(i,3)-4./3.*cc3(i,1)+8./3.*cc3(i,3)-4./3.*
     #  cc3(i,4)-4./3.*cc2(i,1)-4./3.*cc2(i,2)+8./3.*cc2(i,3))
      ft5(i)= ft5(i)+sh*(4./3.*cp3(i,3)-4./3.*cp3(i,4)-4./3.*
     #  cp2(i,2)+8./3.*cp2(i,3)+4./3.*cp1(i,2)+4*cm3(i,3)-4*
     #  cm3(i,4)-4*cm2(i,2)+8*cm2(i,3)+4*cm1(i,2)-4./3.*cc3(i,3)
     #  +4./3.*cc3(i,4)+4./3.*cc2(i,2)-8./3.*cc2(i,3)-4./3.*cc1(i,2))
      ft5(i)= ft5(i)+(-8*cp3(i,5)+8*cp3(i,6)-8./3.*cp2(i,4)
     #  -24*cm3(i,5)+24*cm3(i,6)-8*cm2(i,4)+8*cc3(i,5)-8*
     #  cc3(i,6)+8./3.*cc2(i,4))
*
      ft6(i)= 2.d0*tqm2*(-cp1(i,1)-cp1(i,2)-cp0(i)
     #  +cm1(i,1)+cm1(i,2)+cm0(i))
      ft6(i)= ft6(i)+sph*(-4./3.*cp3(i,2)+4./3.*cp3(i,3)-4*
     #  cm3(i,2)+4*cm3(i,3)+4./3.*cc3(i,2)-4./3.*cc3(i,3))
      ft6(i)= ft6(i)+smh*(-4./3.*cp3(i,1)+4./3.*cp3(i,4)-4*
     #  cp2(i,1)+4./3.*cp2(i,2)+8./3.*cp2(i,3)-8./3.*cp1(i,1)
     #  +8./3.*cp1(i,2)-4*cm3(i,1)+4*cm3(i,4)-12*cm2(i,1)+4
     #  *cm2(i,2)+8*cm2(i,3)-8*cm1(i,1)+8*cm1(i,2)+4./3.*cc3(i,1)
     #  -4./3.*cc3(i,4)+4*cc2(i,1)-4./3.*cc2(i,2)-8./3.*
     #  cc2(i,3)+8./3.*cc1(i,1)-8./3.*cc1(i,2))
      ft6(i)= ft6(i)+sh*(-4./3.*cp3(i,3)-4./3.*cp3(i,4)-4./3.
     #  *cp2(i,2)-8./3.*cp2(i,3)-4./3.*cp1(i,2)-4*cm3(i,3)-4*
     #  cm3(i,4)-4*cm2(i,2)-8*cm2(i,3)-4*cm1(i,2)+4./3.*cc3(i,3)
     #  +4./3.*cc3(i,4)+4./3.*cc2(i,2)+8./3.*cc2(i,3)+4./3.
     #  *cc1(i,2))
      ft6(i)= ft6(i)+(8*cp3(i,5)+8*cp3(i,6)+8*cp2(i,4)+24*
     #  cm3(i,5)+24*cm3(i,6)+24*cm2(i,4)-8*cc3(i,5)-8*cc3(i,6)
     #  -8*cc2(i,4))
*
      endif
*
      ftz1(i)= 4.d0*tqm2*(cp1(i,1)-cp1(i,2)+cp0(i)-
     #  cm1(i,1)+cm1(i,2)-cm0(i))
      ftz1(i)= ftz1(i)+sph*(cp3(i,2)+cp3(i,3)-2*cp3(i,4)+3*
     #  cm3(i,2)+3*cm3(i,3)-6*cm3(i,4))
      ftz1(i)= ftz1(i)+smh*(-cp3(i,1)+2*cp3(i,3)-cp3(i,4)-
     #  cp2(i,1)-cp2(i,2)+2*cp2(i,3)-3*cm3(i,1)+6*cm3(i,3)-
     #  3*cm3(i,4)-3*cm2(i,1)-3*cm2(i,2)+6*cm2(i,3))
      ftz1(i)= ftz1(i)+sh*(-cp3(i,3)+cp3(i,4)+cp2(i,2)+cp1(i,
     #  2)-3*cm3(i,3)+3*cm3(i,4)+3*cm2(i,2)+3*cm1(i,2))
      ftz1(i)= ftz1(i)+(2*cp3(i,5)-2*cp3(i,6)-2*cp2(i,4)+6*
     #  cm3(i,5)-6*cm3(i,6)-6*cm2(i,4))
*
      ftz2(i)= 2.d0*tqm2*(cp1(i,1)+cp1(i,2)+cp0(i)-
     #  cm1(i,1)-cm1(i,2)-cm0(i))
      ftz2(i)= ftz2(i)+sph*(1./2.*cp3(i,2)-1./2.*cp3(i,3)+
     #  cp2(i,2)-cp2(i,3)+3./2.*cm3(i,2)-3./2.*cm3(i,3)+3*cm2(i,2)
     #  -3*cm2(i,3))
      ftz2(i)= ftz2(i)+smh*(1./2.*cp3(i,1)-1./2.*cp3(i,4)+1./2.
     #  *cp2(i,1)-1./2.*cp2(i,2)+3./2.*cm3(i,1)-3./2.*cm3(i,4)
     #  +3./2.*cm2(i,1)-3./2.*cm2(i,2))
      ftz2(i)= ftz2(i)+sh*(1./2.*cp3(i,3)+1./2.*cp3(i,4)+1./2.*
     #  cp2(i,2)+cp2(i,3)+1./2.*cp1(i,2)+3./2.*cm3(i,3)+3./2.
     #  *cm3(i,4)+3./2.*cm2(i,2)+3*cm2(i,3)+3./2.*cm1(i,2))
      ftz2(i)= ftz2(i)+(-cp3(i,5)-cp3(i,6)-cp2(i,4)-3*cm3(i,5)
     #  -3*cm3(i,6)-3*cm2(i,4))
*
      ftz3(i)= 2.d0*tqm2*(-cp1(i,1)+cp1(i,2)-cp0(i)
     #  +cm1(i,1)-cm1(i,2)+cm0(i))
      ftz3(i)= ftz3(i)+sph*(-3./2.*cp3(i,2)-3./2.*cp3(i,3)+3*
     #  cp3(i,4)+cp2(i,2)-cp2(i,3)-9./2.*cm3(i,2)-9./2.*cm3(i,3)
     #  +9*cm3(i,4)+3*cm2(i,2)-3*cm2(i,3))
      ftz3(i)= ftz3(i)+smh*(3./2.*cp3(i,1)-3*cp3(i,3)+3./2.*
     #  cp3(i,4)+5./2.*cp2(i,1)+3./2.*cp2(i,2)-4*cp2(i,3)+
     #  cp1(i,1)-cp1(i,2)+9./2.*cm3(i,1)-9*cm3(i,3)+9./2.*
     #  cm3(i,4)+15./2.*cm2(i,1)+9./2.*cm2(i,2)-12*cm2(i,3)+3
     #  *cm1(i,1)-3*cm1(i,2))
      ftz3(i)= ftz3(i)+sh*(3./2.*cp3(i,3)-3./2.*cp3(i,4)-3./2.*
     #  cp2(i,2)+cp2(i,3)-1./2.*cp1(i,2)+9./2.*cm3(i,3)-9./2.
     #  *cm3(i,4)-9./2.*cm2(i,2)+3*cm2(i,3)-3./2.*cm1(i,2))
      ftz3(i)= ftz3(i)+(-3*cp3(i,5)+3*cp3(i,6)-cp2(i,4)-9*
     #  cm3(i,5)+9*cm3(i,6)-3*cm2(i,4))
*
      ftz4(i)= 4*cp3(i,3)-4*cp3(i,4)-4*cp2(i,2)+4*
     #  cp2(i,3)+12*cm3(i,3)-12*cm3(i,4)-12*cm2(i,2)+12*cm2(i,3)
      ftz4(i)= sh*ftz4(i)
*
      if(rio.eq.'i') then
         ftz5(i)= 0.d0
         ftz6(i)= 0.d0
      else if(rio.eq.'a') then
*
      ftz5(i)= 4.d0*tqm2*(-cp1(i,1)+cp1(i,2)-cp0(i)
     #  +cm1(i,1)-cm1(i,2)+cm0(i))
      ftz5(i)= ftz5(i)+sph*(-1./3.*cp3(i,2)-1./3.*cp3(i,3)+2./
     #  3.*cp3(i,4)-cm3(i,2)-cm3(i,3)+2*cm3(i,4)-8./3.*cc3(i,2)
     #  -8./3.*cc3(i,3)+16./3.*cc3(i,4))
      ftz5(i)= ftz5(i)+smh*(1./3.*cp3(i,1)-2./3.*cp3(i,3)+1./3.
     #  *cp3(i,4)+1./3.*cp2(i,1)+1./3.*cp2(i,2)-2./3.*cp2(i,3)
     #  +cm3(i,1)-2*cm3(i,3)+cm3(i,4)+cm2(i,1)+cm2(i,2)-2
     #  *cm2(i,3)+8./3.*cc3(i,1)-16./3.*cc3(i,3)+8./3.*cc3(i,4)
     #  +8./3.*cc2(i,1)+8./3.*cc2(i,2)-16./3.*cc2(i,3))
      ftz5(i)= ftz5(i)+sh*(1./3.*cp3(i,3)-1./3.*cp3(i,4)-1./3.*
     #  cp2(i,2)+2./3.*cp2(i,3)+1./3.*cp1(i,2)+cm3(i,3)-cm3(i,4)
     #  -cm2(i,2)+2*cm2(i,3)+cm1(i,2)+8./3.*cc3(i,3)-8./
     #  3.*cc3(i,4)-8./3.*cc2(i,2)+16./3.*cc2(i,3)+8./3.*cc1(i,2))
      ftz5(i)= ftz5(i)+(-2*cp3(i,5)+2*cp3(i,6)-2./3.*cp2(i,4)
     #  -6*cm3(i,5)+6*cm3(i,6)-2*cm2(i,4)-16*cc3(i,5)+16*
     #  cc3(i,6)-16./3.*cc2(i,4))
*
      ftz6(i)= 4.d0*tqm2*(cp1(i,1)+cp1(i,2)+cp0(i)-
     #  cm1(i,1)-cm1(i,2)-cm0(i))
      ftz6(i)= ftz6(i)+sph*(-1./3.*cp3(i,2)+1./3.*cp3(i,3)-
     #  cm3(i,2)+cm3(i,3)-8./3.*cc3(i,2)+8./3.*cc3(i,3))
      ftz6(i)= ftz6(i)+smh*(-1./3.*cp3(i,1)+1./3.*cp3(i,4)-
     #  cp2(i,1)+1./3.*cp2(i,2)+2./3.*cp2(i,3)-2./3.*cp1(i,1)
     #  +2./3.*cp1(i,2)-cm3(i,1)+cm3(i,4)-3*cm2(i,1)+cm2(i,2)
     #  +2*cm2(i,3)-2*cm1(i,1)+2*cm1(i,2)-8./3.*cc3(i,1)+
     #  8./3.*cc3(i,4)-8*cc2(i,1)+8./3.*cc2(i,2)+16./3.*cc2(i,3)
     #  -16./3.*cc1(i,1)+16./3.*cc1(i,2))
      ftz6(i)= ftz6(i)+sh*(-1./3.*cp3(i,3)-1./3.*cp3(i,4)-1./3.
     #  *cp2(i,2)-2./3.*cp2(i,3)-1./3.*cp1(i,2)-cm3(i,3)-cm3(i,4)
     #  -cm2(i,2)-2*cm2(i,3)-cm1(i,2)-8./3.*cc3(i,3)-8./
     #  3.*cc3(i,4)-8./3.*cc2(i,2)-16./3.*cc2(i,3)-8./3.*cc1(i,2))
      ftz6(i)= ftz6(i)+(2*cp3(i,5)+2*cp3(i,6)+2*cp2(i,4)+6*
     #  cm3(i,5)+6*cm3(i,6)+6*cm2(i,4)+16*cc3(i,5)+16*cc3(i,6)
     #  +16*cc2(i,4))
*
      endif
*
         enddo
*/////////////////////////////////////////////////////////////////////
      endif
*
         if(ofl.eq.'c'.or.ofl.eq.'a') then
          astrrs= 0.5d0-strrs
          saimz= stris*aimz
          arz= astrrs*rz
          aaimz= astrrs*aimz
          raimz= strrs*aimz
          srz= stris*rz
          if(ofl.eq.'c') then
           cvg1r= 3.d0*f1(1)+ft1(1)-8.d0*p3qs(1)
           cvg2r= 3.d0*f2(1)+ft2(1)
           cvg3r= 3.d0*f3(1)+ft3(1)
           cvg4r= 3.d0*f4(1)+ft4(1)
           cvg5r= ft5(1)
           cvg6r= ft6(1)
           cvg1i= 3.d0*f1(2)+ft1(2)-8.d0*p3qs(2)
           cvg2i= 3.d0*f2(2)+ft2(2)
           cvg3i= 3.d0*f3(2)+ft3(2)
           cvg4i= 3.d0*f4(2)+ft4(2)
           cvg5i= ft5(2)
           cvg6i= ft6(2)
           cvz1r= ftz1(1)*ctrrsi-ftz1(2)*ctrisi
           cvz1i= ftz1(1)*ctrisi+ftz1(2)*ctrrsi
           cvz2r= ftz2(1)*ctrrsi-ftz2(2)*ctrisi
           cvz2i= ftz2(1)*ctrisi+ftz2(2)*ctrrsi
           cvz3r= ftz3(1)*ctrrsi-ftz3(2)*ctrisi
           cvz3i= ftz3(1)*ctrisi+ftz3(2)*ctrrsi
           cvz4r= ftz4(1)*ctrrsi-ftz4(2)*ctrisi
           cvz4i= ftz4(1)*ctrisi+ftz4(2)*ctrrsi
           cvz5r= ftz5(1)*ctrrsi-ftz5(2)*ctrisi
           cvz5i= ftz5(1)*ctrisi+ftz5(2)*ctrrsi
           cvz6r= ftz6(1)*ctrrsi-ftz6(2)*ctrisi
           cvz6i= ftz6(1)*ctrisi+ftz6(2)*ctrrsi
*
           cvc1r= cvg1r+0.5d0*cvz1r
           cvc1i= cvg1i+0.5d0*cvz1i
           cvc2r= cvg2r+0.5d0*cvz2r
           cvc2i= cvg2i+0.5d0*cvz2i
           cvc3r= cvg3r+0.5d0*cvz3r
           cvc3i= cvg3i+0.5d0*cvz3i
           cvc4r= cvg4r+0.5d0*cvz4r
           cvc4i= cvg4i+0.5d0*cvz4i
           cvc5r= cvg5r+0.5d0*cvz5r
           cvc5i= cvg5i+0.5d0*cvz5i
           cvc6r= cvg6r+0.5d0*cvz6r
           cvc6i= cvg6i+0.5d0*cvz6i
*
          else if(ofl.eq.'a') then
           cvg1r= acg1g+0.5d0*sh/wm2*aclg
           cvg2r= 0.5d0*(acg1g+ackg)+0.5d0*(1.d0-sh/wm2)*aclg
           cvg3r= 0.d0
           cvg4r= sh/wm2*aclg
           cvg5r= 0.d0
           cvg6r= -acg5g
           cvg1i= 0.d0
           cvg2i= 0.d0
           cvg3i= 0.5d0*acg4g
           cvg4i= 0.d0
           cvg5i= -(acktg-acltg)
           cvg6i= 0.d0
*
           cvc1r= acg1z+0.5d0*sh/wm2*aclz
           cvc2r= 0.5d0*(acg1z+ackz)+0.5d0*(1.d0-sh/wm2)*aclz
           cvc3r= 0.d0
           cvc4r= sh/wm2*aclz
           cvc5r= 0.d0
           cvc6r= -acg5z
           cvc1i= 0.d0
           cvc2i= 0.d0
           cvc3i= 0.5d0*acg4z
           cvc4i= 0.d0
           cvc5i= -(acktz-acltz)
           cvc6i= 0.d0
          endif
*
          cv1ar= -0.5d0*(strrs*cvg1r-stris*cvg1i)-0.5d0*
     #          arz*cvc1r-0.5d0*srz*cvc1i+0.5d0*
     #          aaimz*cvc1i-0.5d0*saimz*cvc1r
          cv1ai= -0.5d0*(strrs*cvg1i+stris*cvg1r)-0.5d0*
     #          arz*cvc1i+0.5d0*srz*cvc1r-0.5d0*
     #          aaimz*cvc1r-0.5d0*saimz*cvc1i
          cv2ar= -0.5d0*(strrs*cvg2r-stris*cvg2i)-0.5d0*
     #          arz*cvc2r-0.5d0*srz*cvc2i+0.5d0*
     #          aaimz*cvc2i-0.5d0*saimz*cvc2r
          cv2ai= -0.5d0*(strrs*cvg2i+stris*cvg2r)-0.5d0*
     #          arz*cvc2i+0.5d0*srz*cvc2r-0.5d0*
     #          aaimz*cvc2r-0.5d0*saimz*cvc2i
          cv3ar= -0.5d0*(strrs*cvg3r-stris*cvg3i)-0.5d0*
     #          arz*cvc3r-0.5d0*srz*cvc3i+0.5d0*
     #          aaimz*cvc3i-0.5d0*saimz*cvc3r
          cv3ai= -0.5d0*(strrs*cvg3i+stris*cvg3r)-0.5d0*
     #          arz*cvc3i+0.5d0*srz*cvc3r-0.5d0*
     #          aaimz*cvc3r-0.5d0*saimz*cvc3i
          cv4ar= -0.5d0*(strrs*cvg4r-stris*cvg4i)-0.5d0*
     #          arz*cvc4r-0.5d0*srz*cvc4i+0.5d0*
     #          aaimz*cvc4i-0.5d0*saimz*cvc4r
          cv4ai= -0.5d0*(strrs*cvg4i+stris*cvg4r)-0.5d0*
     #          arz*cvc4i+0.5d0*srz*cvc4r-0.5d0*
     #          aaimz*cvc4r-0.5d0*saimz*cvc4i
          cv5ar= -0.5d0*(strrs*cvg5r-stris*cvg5i)-0.5d0*
     #          arz*cvc5r-0.5d0*srz*cvc5i+0.5d0*
     #          aaimz*cvc5i-0.5d0*saimz*cvc5r
          cv5ai= -0.5d0*(strrs*cvg5i+stris*cvg5r)-0.5d0*
     #          arz*cvc5i+0.5d0*srz*cvc5r-0.5d0*
     #          aaimz*cvc5r-0.5d0*saimz*cvc5i
          cv6ar= -0.5d0*(strrs*cvg6r-stris*cvg6i)-0.5d0*
     #          arz*cvc6r-0.5d0*srz*cvc6i+0.5d0*
     #          aaimz*cvc6i-0.5d0*saimz*cvc6r
          cv6ai= -0.5d0*(strrs*cvg6i+stris*cvg6r)-0.5d0*
     #          arz*cvc6i+0.5d0*srz*cvc6r-0.5d0*
     #          aaimz*cvc6r-0.5d0*saimz*cvc6i
          cv1br= -0.5d0*(strrs*(cvg1r-rz*cvc1r)-
     #           stris*(cvg1i-rz*cvc1i))-0.5d0*
     #           raimz*cvc1i-0.5d0*saimz*cvc1r
          cv1bi= -0.5d0*(stris*(cvg1r-rz*cvc1r)+
     #           strrs*(cvg1i-rz*cvc1i))+0.5d0*(
     #           raimz*cvc1r-saimz*cvc1i)            
          cv2br= -0.5d0*(strrs*(cvg2r-rz*cvc2r)-
     #           stris*(cvg2i-rz*cvc2i))-0.5d0*
     #           raimz*cvc2i-0.5d0*saimz*cvc2r
          cv2bi= -0.5d0*(stris*(cvg2r-rz*cvc2r)+
     #           strrs*(cvg2i-rz*cvc2i))+0.5d0*(
     #           raimz*cvc2r-saimz*cvc2i)            
          cv3br= -0.5d0*(strrs*(cvg3r-rz*cvc3r)-
     #           stris*(cvg3i-rz*cvc3i))-0.5d0*
     #           raimz*cvc3i-0.5d0*saimz*cvc3r
          cv3bi= -0.5d0*(stris*(cvg3r-rz*cvc3r)+
     #           strrs*(cvg3i-rz*cvc3i))+0.5d0*(
     #           raimz*cvc3r-saimz*cvc3i)            
          cv4br= -0.5d0*(strrs*(cvg4r-rz*cvc4r)-
     #           stris*(cvg4i-rz*cvc4i))-0.5d0*
     #           raimz*cvc4i-0.5d0*saimz*cvc4r
          cv4bi= -0.5d0*(stris*(cvg4r-rz*cvc4r)+
     #           strrs*(cvg4i-rz*cvc4i))+0.5d0*(
     #           raimz*cvc4r-saimz*cvc4i)            
          cv5br= -0.5d0*(strrs*(cvg5r-rz*cvc5r)-
     #           stris*(cvg5i-rz*cvc5i))-0.5d0*
     #           raimz*cvc5i-0.5d0*saimz*cvc5r
          cv5bi= -0.5d0*(stris*(cvg5r-rz*cvc5r)+
     #           strrs*(cvg5i-rz*cvc5i))+0.5d0*(
     #           raimz*cvc5r-saimz*cvc5i)            
          cv6br= -0.5d0*(strrs*(cvg6r-rz*cvc6r)-
     #           stris*(cvg6i-rz*cvc6i))-0.5d0*
     #           raimz*cvc6i-0.5d0*saimz*cvc6r
          cv6bi= -0.5d0*(stris*(cvg6r-rz*cvc6r)+
     #           strrs*(cvg6i-rz*cvc6i))+0.5d0*(
     #           raimz*cvc6r-saimz*cvc6i)            
*
         endif
*      endif
*
      if(oqcd.eq.'y') then
         if(iqcd.lt.2) then
            qcdjac= (1.d0+0.5d0*als/pi*(fcuc-1.d0))*
     #              (1.d0+0.5d0*als/pi*(fcdc-1.d0))-1.d0
         else
            nf= 5
            scalp= sqrt(vv)*ssp*ars
            scalm= sqrt(vv)*ssm*ars
            alsp= wtorals(qcdl,scalp,nf)
            alsm= wtorals(qcdl,scalm,nf)
            qcdjac= (1.d0+0.5d0*alsp/pi*(fcuc-1.d0))*
     #              (1.d0+0.5d0*alsm/pi*(fcdc-1.d0))-1.d0
         endif
      else
         qcdjac= 0.d0
      endif
*
      cbw= -1.d0+sp-sm
      ifcr= 1
      call c02ajf(one,cbw,sm,bt1,bt2,ifcr)
      if(ifcr.ne.0.or.bt1(2).ne.0.d0) then
         iz= 0
         ifz(7)= ifz(7)+1
         go to 1
      endif
*
*-----Coul factors
*
      if(ocoul.eq.'y') then
         betb= 1.d0-2.d0*(sp+sm)+(sp-sm)*(sp-sm)
         if(betb.le.0.d0) then
            iz= 0
            ifz(8)= ifz(8)+1
            go to 1
         endif
         betb= sqrt(betb)
         bdel= abs(sp-sm)
         bmsr= 1.d0-4.d0*rwm2/vv
         bmsi= 4.d0*rwm*rwg/vv+1.d-20
         abm= sqrt(bmsr*bmsr+bmsi*bmsi)
         bmr= sqrt(0.5d0*(abm+bmsr))
         bmi= 0.5d0*bmsi/bmr
         acoulf= (bmr+bdel)*(bmr+bdel)+bmi*bmi-betb*betb
         acoulf= 0.5d0*acoulf/betb/bmi
         acoulf= atan(acoulf)
         coulf= 0.5d0*alw*pi/betb*(1.d0-2.d0/pi*acoulf)
      else
         coulf= 0.d0
      endif
      ssmpp= ssm+ssp
      ssmmp= ssm-ssp
      asup= 1.d0-ssmpp*ssmpp
      asum= 1.d0-ssmmp*ssmmp
      if(asup.lt.0.d0.or.asum.lt.0.d0) then
         iz= 0
         ifz(9)= ifz(9)+1
         go to 1
      endif
      rasup= sqrt(asup)
      rasum= sqrt(asum)
*
*-----initialization of su = M_0^2
*
*-----limits on su from cuts on FS IM
*
      sulim= rrl(4)
      suuim1= rrr(4)
      suuim2= (1.d0-srrl(3))*(1.d0-srrl(3))          
      suuim= dmin1(suuim1,suuim2)
*
*-----limits on su from Delta_-  0 (as derived from consistency
*     on sd limits)
*
      suud1= 0.25d0*(rasup+rasum)*(rasup+rasum)
      suud2= 0.25d0*(1.d0+rasup)*(1.d0+rasup)
*
      sul= sulim
      sul= dmax1(sul,sct23)
      if(ieq.eq.0) then
         sul1= bl(2)+bl(3)-1.d0
         suu1= 1.d0-sp-bl(1)
         suu2= 1.d0-sm-bl(4)
         suu3= (1.d0-0.5d0*(bl(1)+bl(4)))*
     #          (1.d0-0.5d0*(bl(1)+bl(4)))
      else if(ieq.eq.1) then
         sul1= xbl(2)+xbl(3)+1.d0-2.d0*enc
         suu1= enc-sp-xbl(1)
         suu2= enc-sm-xbl(4)
         suu3= (enc-0.5d0*(xbl(1)+xbl(4)))*
     #         (enc-0.5d0*(xbl(1)+xbl(4)))
      endif
      sul= dmax1(sul,sul1)
      suu= dmin1(suuim,suud1,suud2,suu1,suu2,suu3)
*
      sdlim= rrl(3)
      if(itc.eq.7.and.itcc.eq.2) then
         dsdl= dmax1(sdlim,sct140)
         dsuu= (dist/svv/rs-sqrt(dsdl))*(dist/svv/rs-sqrt(dsdl))
         suu= dmin1(suu,dsuu)
      endif
      if(itc.eq.7.and.itcc.eq.3) then
         suud3= 1.d0-sm-sp-0.5d0*dist*dist/vv/s
         suu= dmin1(suu,suud3)
      endif
*
*-----test on su
*
      if(suu.le.sul) then
         iz= 0
         ifz(10)= ifz(10)+1
         go to 1
      endif
*
      if(itc.eq.13) then
         bdistl= 2.d0*arrinv(3)/vv-sul
         bdistu= suu-2.d0*arrinv(3)/vv
         if(bdistl.le.0.d0.or.bdistu.le.0.d0) then
            iz= 0
            ifz(10)= ifz(10)+1
            go to 1
         endif
         su= 2.d0*arrinv(3)/vv
         sujc= 2.d0/sh
      else
         sujc= suu-sul
         su= sujc*sux+sul
      endif
      if(su.lt.0.d0) then
         iz= 0
         ifz(10)= ifz(10)+1
         go to 1
      endif
      ssu= sqrt(su)
*
*-----initialization of sd = m_0^2
*
*-----limits on sd from cuts on FS IM
*
      sduim1= rrr(3)
      sduim2= (1.d0-ssu)*(1.d0-ssu)
      sduim= dmin1(sduim1,sduim2)
*
*-----limits on sd from Delta_-  0
*
      if(ssu.gt.rasup) then
         sdld= (ssu-rasup)*(ssu-rasup)
      else
         sdld= sdlim
      endif
      sdud1= (ssu+rasup)*(ssu+rasup)
      sdud2= (-ssu+rasum)*(-ssu+rasum)
      sdud= dmin1(sdud1,sdud2)
*
*-----limits on sd from cuts on S. Here for maximum security. Rare
*
      if(iac(3).ne.0.and.ss(4).eq.ss(1).and.ss(3).eq.ss(2)) then 
         if(ss(2).eq.ss(1)) then
            asdu= dmin1(sduim,sdud)
            asdl= dmax1(sdlim,sdld)
         else if(ss(1).gt.ss(2)) then
            sdusa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2))
            asdu= dmin1(sduim,sdud,sdusa)
            asdl= dmax1(sdlim,sdld)
         else if(ss(1).lt.ss(2)) then
            asdu= dmin1(sduim,sdud)
            sdlsa= su+(1.d0-ss(1)-ss(2))/(ss(1)-ss(2))
            asdl= dmax1(sdlim,sdld,sdlsa)
         endif
      else
         asdu= dmin1(sduim,sdud)
         asdl= dmax1(sdlim,sdld)
      endif
      if(iac(3).ne.0.and.cs(4).eq.cs(1).and.cs(3).eq.cs(2)) then 
         if(cs(2).eq.cs(1)) then
            sdl= asdl
            sdu= asdu
         else if(cs(1).gt.cs(2)) then
            sdu= asdu
            sdlsb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2))
            sdl= dmax1(asdl,sdlsb)
         else if(cs(1).lt.cs(2)) then
            sdl= asdl
            sdusb= su+(1.d0-cs(1)-cs(2))/(cs(1)-cs(2))
            sdu= dmin1(asdu,sdusb)
         endif
      else
         sdl= asdl
         sdu= asdu
      endif
*
      if(ieq.eq.0) then
         sdenl= -1.d0+bl(1)+bl(4)+su
         sdenu1= 1.d0-sp-bl(2)
         sdenu2= 1.d0-sm-bl(3)
         sdenu3= 1.d0-bl(2)-bl(3)+su
      else if(ieq.eq.1) then
         sdenl= su+1.d0-2.d0*enc+xbl(1)+xbl(4)
         sdenu1= enc-sp-xbl(2)
         sdenu2= enc-sm-xbl(3)
         sdenu3= su-1.d0+2.d0*enc-xbl(2)-xbl(3)
      endif
      sdl= dmax1(sdl,sdenl)
      sdu= dmin1(sdu,sdenu1,sdenu2,sdenu3)
      sdl= dmax1(sdl,sct14)
      if(itc.eq.7.and.itcc.eq.3) then
         sdld3= 1.d0-sm-sp-su-dist*dist/vv/s
         sdl= dmax1(sdl,sdld3)
         sdud3= 1.d0-sm-sp-su-0.5d0*dist*dist/vv/s
         sdu= dmin1(sdu,sdud3)
      endif
*
*-----test on sd
*
      if(sdu.le.sdl) then
         iz= 0
         ifz(11)= ifz(11)+1
         go to 1
      endif
*
      if(itc.eq.7.and.itcc.eq.2) then
         bdistl= (dist/rs-svv*ssu)*(dist/rs-svv*ssu)-vv*sdl
         bdistu= vv*sdu-(dist/rs-svv*ssu)*(dist/rs-svv*ssu)
         if(bdistl.le.0.d0.or.bdistu.le.0.d0) then
            iz= 0
            ifz(11)= ifz(11)+1
            go to 1
         endif
      endif
*
      if(itc.eq.7.and.itcc.eq.2) then
         sd= (dist/rs/svv-ssu)*(dist/rs/svv-ssu)
         sdjc= 2.d0*abs((dist/rs-svv*ssu))/vv/ars
      else if(itc.eq.13) then
         bdistl= 2.d0*arrinv(4)/vv-sdl
         bdistu= sdu-2.d0*arrinv(4)/vv
         if(bdistl.le.0.d0.or.bdistu.le.0.d0) then
            iz= 0
            ifz(11)= ifz(11)+1
            go to 1
         endif
         sd= 2.d0*arrinv(4)/vv
         sdjc= 2.d0/sh
      else
         sdjc= sdu-sdl
         sd= sdjc*sdx+sdl
      endif
*
      if(sd.lt.0.d0) then
         iz= 0
         ifz(11)= ifz(11)+1
         go to 1
      endif
      ssd= sqrt(sd)
      sdmu= sd-su
      sdmus= (1.d0+sdmu)*(1.d0+sdmu)
*
*-----initialization of sf = m^2
*
*-----limits on sf from cuts on FS IM
*
      sflim1= rrl(2)
      sfuim1= rrr(2)
      bsg= sm+sp+su+sd
      ombsg= 1.d0-bsg
      sflim2= ombsg-rrr(5)
      sfuim2= ombsg-rrl(5)
      sflim= dmax1(sflim1,sflim2)
      sfuim= dmin1(sfuim1,sfuim2)
*
*-----limits on sf from cuts on S
*
      tcuts= ss(1)-ss(2)+ss(3)-ss(4)
      tcutc= cs(1)-cs(2)+cs(3)-cs(4)
      if(iac(3).ne.0.and.tcuts.ne.0.d0.and.tcutc.ne.0.d0) then
         if(tcuts.gt.0.d0.and.tcutc.gt.0.d0) then
            sflsa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-
     #             (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp-
     #             (cs(1)-cs(4))*sm)/tcutc 
            sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-
     #             (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-
     #             (ss(1)-ss(4))*sm)/tcuts 
            asfl= dmax1(sflim,sflsa)
            asfu= dmin1(sfuim,sfusa)
         else if(tcuts.gt.0.d0.and.tcutc.lt.0.d0) then
            sfusa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-
     #             (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-
     #             (ss(1)-ss(4))*sm)/tcuts 
            sfusb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-
     #             (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp-
     #             (cs(1)-cs(4))*sm)/tcutc 
            asfu= dmin1(sfuim,sfusa,sfusb)
            asfl= sflim            
         else if(tcuts.lt.0.d0.and.tcutc.gt.0.d0) then
            sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-
     #             (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-
     #             (ss(1)-ss(4))*sm)/tcuts 
            sflsb= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-
     #             (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp-
     #             (cs(1)-cs(4))*sm)/tcutc 
            asfl= dmax1(sflim,sflsa,sflsb)
            asfu= sfuim            
         else if(tcuts.lt.0.d0.and.tcutc.lt.0.d0) then
            sflsa= (1.d0-ss(2)-ss(4)-(ss(1)-ss(2))*sd-
     #             (ss(3)-ss(4))*su-(ss(3)-ss(2))*sp-
     #             (ss(1)-ss(4))*sm)/tcuts 
            sfusa= (1.d0-cs(2)-cs(4)-(cs(1)-cs(2))*sd-
     #             (cs(3)-cs(4))*su-(cs(3)-cs(2))*sp-
     #             (cs(1)-cs(4))*sm)/tcutc 
            asfl= dmax1(sflim,sflsa)
            asfu= dmin1(sfuim,sfusa)
         endif
      else
         asfl= sflim
         asfu= sfuim
      endif
*
      if(ieq.eq.0) then
         asfenl1= bl(1)-sm-sd
         asfenl2= bl(3)-sp-su
         asfenu1= 1.d0-bl(2)-sp-sd
         asfenu2= 1.d0-bl(4)-sm-su
      else if(ieq.eq.1) then
         asfenl1= 1.d0-enc-sm-sd+xbl(1)
         asfenl2= 1.d0-enc-sp-su+xbl(3)
         asfenu1= enc-sp-sd-xbl(2)
         asfenu2= enc-sm-su-xbl(4)
      endif
      asfl= dmax1(asfl,asfenl1,asfenl2)
      asfu= dmin1(asfu,asfenu1,asfenu2)
      aasfu= 1.d0-sm-sp-su-sd-sct24
      asfl= dmax1(asfl,sct13)
      asfu= dmin1(asfu,aasfu)
*
      if(iac(3).ne.0) then
       if(ss(4).ne.ss(3)) then
        if(ss(4).gt.ss(3)) then
           asfltw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+
     #             ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3))
           asfl= dmax1(asfl,asfltw)
        else if (ss(4).lt.ss(3)) then
           asfutw= -(1.d0-ss(3)*sp-ss(3)*su+ss(4)*sm+
     #             ss(4)*su-ss(4)-bt1(1))/(ss(4)-ss(3))
           asfu= dmin1(asfu,asfutw)
        endif
       endif
       if(cs(1).ne.cs(2)) then
        if(cs(1).gt.cs(2)) then
           bsfltw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+
     #             cs(2)-bt1(1))/(cs(1)-cs(2))
           asfl= dmax1(asfl,bsfltw)
        else if(cs(1).lt.cs(2)) then
           bsfutw= -(cs(1)*sm+cs(1)*sd-cs(2)*sp-cs(2)*sd+
     #              cs(2)-bt1(1))/(cs(1)-cs(2))
           asfu= dmin1(asfu,bsfutw)
        endif
       endif
       if(cs(4).ne.cs(3)) then
        if(cs(4).gt.cs(3)) then
           csfutw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm-
     #             cs(4)*su+cs(4))/(cs(4)-cs(3))
           asfu= dmin1(asfu,csfutw)
        else if(cs(4).lt.cs(3)) then
           csfltw= (bt2(1)-1.d0+cs(3)*sp+cs(3)*su-cs(4)*sm-
     #             cs(4)*su+cs(4))/(cs(4)-cs(3))
           asfl= dmax1(asfl,csfltw)
        endif
       endif
       if(ss(1).ne.ss(2)) then
        if(ss(1).gt.ss(2)) then
           dsfutw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+
     #             ss(2)*sd-ss(2))/(ss(1)-ss(2))
           asfu= dmin1(asfu,dsfutw)
        else if(ss(1).lt.ss(2)) then
           dsfltw= (bt2(1)-ss(1)*sm-ss(1)*sd+ss(2)*sp+
     #             ss(2)*sd-ss(2))/(ss(1)-ss(2))
           asfl= dmax1(asfl,dsfltw)
        endif
       endif
      endif
*
*-----positivity of R^2
*
      scp= ssmpp*ssmpp      
      scm= ssmmp*ssmmp      
      snp= (ssu+ssd)*(ssu+ssd)      
      snm= (ssu-ssd)*(ssu-ssd)      
      rlp= ssu*ssd+ssp*ssm
      rlm= ssu*ssd-ssp*ssm
      bsgmo= bsg-1.d0
      ombsg2= ombsg*ombsg
      rlps= rlp*rlp
      rlms= rlm*rlm
      edelp= ombsg2-4.d0*rlps
      edelm= ombsg2-4.d0*rlms
      edeld= 16.d0*ssu*ssd*ssp*ssm
*
*-----first Delta_- > 0 > Delta_+ with Sigma > or < 1/2
*     then Delta_+ > 0
*
*-----control
*
      cnt1= scp+snm
      cnt2= scm+snp
      if(cnt1.gt.1.d0.or.cnt2.gt.1.d0) then
         iz= 0
         ifz(12)= ifz(12)+1
         go to 1
      endif
      if(edelm.le.0.d0) then
         etest= edeld+edelp
         if(etest.gt.0.d0) then
            edelm= etest
         else
            iz= 0
            ifz(3)= ifz(13)+1
            go to 1
         endif
      endif
      sedm= sqrt(edelm)
      ifcr= 1
      call c02ajf(one,bsgmo,rlms,rr1,rr2,ifcr)
      if(ifcr.ne.0) then
         iz= 0
         ifz(14)= ifz(14)+1
         go to 1
      endif
      ifcr= 1
      call c02ajf(one,bsgmo,rlps,rs1,rs2,ifcr)
      if(ifcr.ne.0) then
         iz= 0
         ifz(14)= ifz(14)+1
         go to 1
      endif
*
      cnt3= scp+snp
      cnt4= scm+snm
      cbru= -1.d0
      ccru= 0.5d0*bsg
*
*-----R^2 has two real roots and two complex conjugate roots
*
      if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then
         if(bsg.gt.0.5d0) then
            iel= 1
            sflr(1)= rr1(1)
            sfur(1)= rr2(1)
            sflr(2)= rr1(1)
            sfur(2)= rr2(1)
         else
            iel= 2
            ifcr= 1
            call c02ajf(one,cbru,ccru,rru1,rru2,ifcr)
            if(ifcr.ne.0) then
               iz= 0
               ifz(14)= ifz(14)+1
               go to 1
            endif
            ru1= rru1(1)*rru1(1)
            ru2= rru2(1)*rru2(1)
            sflr(1)= rr1(1)
            sflr(2)= ru2
            sfur(1)= ru1
            sfur(2)= rr2(1)
         endif
*
*-----R^2 has four real roots
*
      else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then
         if(bsg.gt.0.5d0) then
            sflr(1)= rr1(1)
            sflr(2)= rs2(1)
            sfur(1)= rs1(1)
            sfur(2)= rr2(1)
         else
            ifcr= 1
            call c02ajf(one,cbru,ccru,rru1,rru2,ifcr)
            if(ifcr.ne.0) then
               iz= 0
               ifz(14)= ifz(14)+1
               go to 1
            endif
            ru1= rru1(1)*rru1(1)
            ru2= rru2(1)*rru2(1)
            sflr(1)= rr1(1)
            sfur(1)= dmin1(rs1(1),ru1)
            sflr(2)= dmax1(rs2(1),ru2)
            sfur(2)= rr2(1)
         endif
      endif
*
*-----the loop for transforming sf starts here
*
      if(om.eq.'g') then
         itmn= it0
         itmx= it0
      else
         itmn= 1
         itmx= 2
      endif
*
      do it=itmn,itmx
           if(sflr(it).ge.asfl) then
              sfl= sflr(it)
           else
              sfl= asfl
           endif
           if(sfur(it).le.asfu) then
              sfu= sfur(it)
           else
              sfu= asfu
           endif
*
*-----test on sf
*
           if(sfu.le.sfl) then
              iz= 0
              ifz(15)= ifz(15)+1
              go to 2
           endif
*
           if(itc.eq.7.and.itcc.eq.3) then
              ittm= 2
           else
              ittm= 1
           endif
*
           do itt=1,ittm
*
           if(itc.eq.7.and.itcc.eq.3) then
              distm= dist/svv/rs
              sbdist= 2.d0*(1.d0-sm-sp-su-sd)-distm*distm
              if(sbdist.le.0.d0) then
                 iz= 0
                 ifz(15)= ifz(15)+1
                 go to 5
              endif
              if(itt.eq.1) then
                 bdist= 0.25d0*(distm-sqrt(sbdist))*
     #                 (distm-sqrt(sbdist))
              else if(itt.eq.2) then
                 bdist= 0.25d0*(distm+sqrt(sbdist))*
     #                 (distm+sqrt(sbdist))
              endif
              bdistl= bdist-sfl
              bdistu= sfu-bdist
              if(bdistl.le.0.d0.or.bdistu.le.0.d0) then
                 iz= 0
                 ifz(15)= ifz(15)+1
                 go to 5
              endif
              sf= bdist
              ssf= sqrt(sf)
              pfjc= 2.d0/vv/rs*ssf*(distm-ssf)/sqrt(sbdist)
              sfjc0= sf*sf+(sm+sp+su+sd-1.d0)*sf+su*sd+sm*sp
              sfjc= 4.d0*sm*sp*su*sd-sfjc0*sfjc0
              if(sfjc.le.0.d0) then
                iz= 0
                ifz(15)= ifz(15)+1
                go to 5
              else
                if(iel.eq.1) then
                   sfjc= 0.5d0*pfjc/sqrt(sfjc)
                else if(iel.eq.2) then
                   sfjc= pfjc/sqrt(sfjc)
                endif
              endif
           else
*
*-----transformation for jacobian, first Delta_+ < 0, then Delta_+ > 0
*
           if(cnt3.gt.1.d0.or.cnt4.gt.1.d0) then
              er= rs1(1)
              es= abs(rs1(2))
              er1= rr1(1)
              er2= rr2(1)
              ek2= edelm/edeld
              ek= sqrt(ek2)
              dog= -2.d0/sqrt(edeld)
              ecpl= (ombsg-2.d0*sfl)/sedm
              ecpu= (ombsg-2.d0*sfu)/sedm
              eql= ecpl*ecpl
              equ= ecpu*ecpu
              omecpl= 2.d0*(sfl-er1)/sedm
              es2pl= omecpl*(2.d0-omecpl)
              erl= 1.d0-ek2*es2pl
              espl= sqrt(es2pl)
              opecpu= 2.d0*(er2-sfu)/sedm
              es2pu= opecpu*(2.d0-opecpu)
              espu= sqrt(es2pu)
              eru= 1.d0-ek2*es2pu
              if(eql.eq.1) then
                 sflt= 0.d0
              else
                 ifel= 1
                 sflt= -dog*espl*s21bbf(eql,erl,one,ifel)
                 if(ifel.ne.0) then
                    iz= 0
                    ifz(16)= ifz(16)+1
                    go to 2
                 endif
              endif
              if(equ.eq.1.d0) then
                 sfut= 0.d0 
              else
                 ifel= 1
                 sfut= -dog*espu*s21bbf(equ,eru,one,ifel)
                 if(ifel.ne.0) then
                    iz= 01
                    ifz(17)= ifz(17)+1
                    go to 2
                 endif
              endif
              if(iel.eq.1) then
                 if(sfu.le.er) then
                    efac= 0.5d0
                    sft= (sfut-sflt)*sfx+sflt
                    ifel= 1 
                    asf= -sft/dog
                    call s21caf(asf,ek2,elsn,elcn,edn,ifel) 
                    if(ifel.ne.0) then
                       iz= 0
                       ifz(18)= ifz(18)+1 
                       go to 2
                    endif 
                    sf= 0.5d0*(ombsg-sedm*elcn)
                    sfjc= efac*(sfut-sflt)
                  else if(sfl.ge.er) then
                    efac= 0.5d0
                    sft= (sflt-sfut)*sfx+sfut 
                    ifel= 1 
                    asf= -sft/dog 
                    call s21caf(asf,ek2,elsn,elcn,edn,ifel)
                    if(ifel.ne.0) then
                       iz= 0
                       ifz(19)= ifz(19)+1
                       go to 2
                    endif
                    sf= 0.5d0*(ombsg+sedm*elcn)
                    sfjc= efac*(sflt-sfut)
                  else
                    efac= 1.d0
                    qbar= 0.d0
                    rbar= 1.d0-ek2
                    ifel= 1
                    sfbar= -dog*s21bbf(qbar,rbar,one,ifel)
                    if(ifel.ne.0) then
                       iz= 0
                       ifz(20)= ifz(20)+1 
                       go to 2
                    endif
                    if(it.eq.1) then
                       sft= (sfbar-sflt)*sfx+sflt
                       ifel= 1
                       asf= -sft/dog
                       call s21caf(asf,ek2,elsn,elcn,edn,ifel)
                       if(ifel.ne.0) then
                          iz= 0
                          ifz(21)= ifz(21)+1
                          go to 2
                       endif
                       sf= 0.5d0*(ombsg-sedm*elcn)
                       sfjc= efac*(sfbar-sflt)
                     else if(it.eq.2) then
                       sft= (sfbar-sfut)*sfx+sfut 
                       ifel= 1
                       asf= -sft/dog
                       call s21caf(asf,ek2,elsn,elcn,edn,ifel)
                       if(ifel.ne.0) then
                          iz= 0
                          ifz(22)= ifz(22)+1
                          go to 2
                       endif
                       sf= 0.5d0*(ombsg+sedm*elcn)
                       sfjc= efac*(sfbar-sfut)
                     endif
                  endif
              else if(iel.eq.2) then
                  efac= 1.d0
                  if(it.eq.1) then
                     sft= (sfut-sflt)*sfx+sflt
                     ifel= 1
                     asf= -sft/dog
                     call s21caf(asf,ek2,elsn,elcn,edn,ifel)
                     if(ifel.ne.0) then
                        iz= 0
                        ifz(23)= ifz(23)+1
                        go to 2
                     endif
                     sf= 0.5d0*(ombsg-sedm*elcn)
                     sfjc= efac*(sfut-sflt)
                  else if(it.eq.2) then
                     sft= (sflt-sfut)*sfx+sfut
                     ifel= 1
                     asf= -sft/dog
                     call s21caf(asf,ek2,elsn,elcn,edn,ifel)
                     if(ifel.ne.0) then
                        iz= 0
                        ifz(24)= ifz(24)+1
                        go to 2 
                     endif
                     sf= 0.5d0*(ombsg+sedm*elcn)
                     sfjc= efac*(sflt-sfut)
                  endif
              endif
           else if(cnt3.lt.1.d0.and.cnt4.lt.1.d0) then
              if(edelp.le.0.d0) then
                 iz= 0
                 ifz(25)= ifz(25)+1 
                 go to 2
              endif
              sedp= sqrt(edelp)
              efac= 1.d0
              es1= rs1(1)
              es2= rs2(1)
              er1= rr1(1)
              er2= rr2(1) 
              ssed= sedm+sedp 
              ek= (sedm-sedp)/ssed
              ek2= ek*ek
              dog= 2.d0/ssed
              if(it.eq.1) then
                 es2pl= (er1-sfl)/(sfl-er2)/ek
                 es2pu= (er1-sfu)/(sfu-er2)/ek 
                 eql= 1.d0-es2pl 
                 equ= 1.d0-es2pu
                 erl= 1.d0-ek2*es2pl
                 eru= 1.d0-ek2*es2pu
              else if(it.eq.2) then
                 es2pl= (sfl-es2)/(sfl-es1)/ek
                 es2pu= (sfu-es2)/(sfu-es1)/ek 
                 eql= 1.d0-es2pl 
                 equ= 1.d0-es2pu
                 erl= 1.d0-ek2*es2pl
                 eru= 1.d0-ek2*es2pu
              endif
                 if(eql.eq.1.d0) then
                    sflt= 0.d0
                 else
                    ifel= 1
                    sflt= 2.d0*dog*sqrt(es2pl)*
     #                    s21bbf(eql,erl,one,ifel)
                    if(ifel.ne.0) then
                       iz= 0
                       ifz(26)= ifz(26)+1 
                       go to 2
                    endif
                 endif
                 if(equ.eq.1.d0) then
                    sfut= 0.d0
                 else
                    ifel= 1 
                    if(equ.lt.0.d0.and.abs(equ).lt.1.d-12) then 
                       equ= 0.d0
                    endif
                    sfut= 2.d0*dog*sqrt(es2pu)*
     #                    s21bbf(equ,eru,one,ifel)
                    if(ifel.ne.0) then
                       iz= 0
                       ifz(27)= ifz(27)+1 
                       go to 2
                    endif 
                 endif
                 sft= (sfut-sflt)*sfx+sflt
                 ifel= 1
                 asf= 0.5d0/dog*sft
                 call s21caf(asf,ek2,elsn,elcn,edn,ifel)
                 elsn2= elsn*elsn
                 if(ifel.ne.0) then 
                    iz= 0 
                    ifz(28)= ifz(28)+1
                    go to 2
                 endif
                 if(it.eq.1) then
                    sf= (er1+ek*elsn2*er2)/(1.d0+ek*elsn2)
                 else if(it.eq.2) then
                    sf= (es2-ek*elsn2*es1)/(1.d0-ek*elsn2)
                 endif
                 sfjc= efac*(sfut-sflt)
           endif
* 
           endif
*
*-----auxiliary quantities x
*
           sdpf= sd+sf
           e3= sp+su+sf
           e4= 1.d0+spmm-e3 
           e3p4= 1.d0+spmm
           e1= sm+sdpf
           e2= 1.d0+smmp-e1
           e1p2= 1.d0+smmp              
           e1p3= e1+e3             
           e1m2= 2.d0*e1-1.d0+spmm              
           ep12= xp*e1*e2
           ep1= xp*e1
           ep2= xp*e2
           ep3= xp*e3 
           ep4= xp*e4
           e1t2= e1*e2
           e1t3= e1*e3
           e1t4= e1*e4
           e2t3= e2*e3
           e2t4= e2*e4
           e3t4= e3*e4
           if((e1p3*e1p3-4.d0*sf).lt.0.d0) then
               iz= 0
               ifz(29)= ifz(29)+1 
               go to 2
           endif
           skl2= sqrt(e1p3*e1p3-4.d0*sf)
           if((sdmus-4.d0*sd).lt.0.d0) then
               iz= 0
               ifz(30)= ifz(30)+1 
               go to 2
           endif
           skl3= sdmus-4.d0*sd
           skl3= sqrt(skl3)
*
*-----initialization of t_w
*
*-----limits on tw from positivity and S 
* 
           twlp1= 0.d0
           twlp2= smmp
           twlp3= spmm-1.d0
           twlp= dmax1(twlp1,twlp2,twlp3)
           twup= 1.d0
* 
*-----limits on tw from cuts on S
* 
           if(iac(3).ne.0) then
              skl2m= 0.5d0*(e1p3-skl2)
              skl2p= 0.5d0*(e1p3+skl2)
              skl3p= -0.5d0*(1.d0+sdmu-skl3)
              skl3m= -0.5d0*(1.d0+sdmu+skl3)
              twlsa1= 1.d0-cs(3)*e3-cs(4)*e4
              twlsa2= ss(1)*e1+ss(2)*e2 
              twlsa3= 1.d0-cs(3)*e3-cs(4)*e4-skl3p+skl3m
              twlsa4= 1.d0-2.d0*cs(3)*e3+skl2m+skl3m
              twlsa5= 1.d0-2.d0*cs(4)*e4-skl2p-skl3p
              twlsa6= 1.d0-cs(3)*e3-cs(4)*e4-skl2p+skl2m
              twusa1= 1.d0-ss(3)*e3-ss(4)*e4
              twusa2= cs(1)*e1+cs(2)*e2
              twusa3= 1.d0-ss(3)*e3-ss(4)*e4+skl3p-skl3m
              twusa4= 1.d0-2.d0*ss(4)*e4-skl2m-skl3m
              twusa5= 1.d0-2.d0*ss(3)*e3+skl2p+skl3p
              twusa6= 1.d0-ss(3)*e3-ss(4)*e4+skl2p-skl2m
              atwl= dmax1(twlp,twlsa1,twlsa2,twlsa3,twlsa4,
     #                    twlsa5,twlsa6)
              atwu= dmin1(twup,twusa1,twusa2,twusa3,twusa4,
     #                    twusa5,twusa6)
           else
              atwl= twlp
              atwu= twup
           endif
*
*-----limits on tw from E
*
           if(ieq.eq.1) then
              atwle= 1.d0-bxe*e3p4+bl(3)+bl(4)
              atwue= bxe*e1p2-bl(1)-bl(2) 
              if(xdf.gt.0.d0) then
                 twle= atwle
                 twue= atwue
              else if(xdf.lt.0.d0) then 
                 atwle1= bxe*e1-bl(1)
                 atwle2= bxe*e2-bl(2)
                 atwue1= 1.d0-bxe*e3+bl(3)
                 atwue2= 1.d0-bxe*e4+bl(4)
                 twle= dmax1(atwue,atwle1,atwle2)
                 twue= dmin1(atwle,atwue1,atwue2)
              endif
              atwl= dmax1(atwl,twle)
              atwu= dmin1(atwu,twue)
           endif
*
*-----natural limits on tw
*
           atwl= dmax1(atwl,bt1(1))
           atwu= dmin1(atwu,bt2(1))
* 
*-----test on tw
* 
           if(atwu.le.atwl) then
              iz= 0 
              ifz(31)= ifz(31)+1
              go to 2 
           endif
           if(itc.eq.13) then
              bdistl= 2.d0*(arrinv(7)+arrinv(8))/uv-atwl
              bdistu= atwu-2.d0*(arrinv(7)+arrinv(8))/uv
              if(bdistl.le.0.d0.or.bdistu.le.0.d0) then 
                 iz= 0
                 ifz(31)= ifz(31)+1 
                 go to 2
              endif
              tw= 2.d0*(arrinv(7)+arrinv(8))/uv
              twjc= 2.d0*xp/sh
           else 
              twjc= atwu-atwl
              tw= twjc*twx+atwl 
           endif
           pn= tw+sp-1.d0
           omtw= 1.d0-tw
* 
*-----initialization of t1
*
*-----limits on t1 from positivity+SA
*
           t1lp1= 0.d0
           t1lp2= pn+sdpf 
           t1up1= tw
           t1up2= sm+sdpf
           t1lp= dmax1(t1lp1,t1lp2)
           t1up= dmin1(t1up1,t1up2)
*
*-----limits on t1 from cuts on SA
*
           if(iac(3).ne.0) then 
              t1lc1= ss(1)*e1 
              t1lc2= tw-cs(2)*e2
              t1lc3= ss(3)*e3-(omtw-0.5d0*(1.d0+sdmu-skl3))
              t1lc4= -cs(4)*e4+0.5d0*(1.d0+sdmu-skl3)
              t1lc5= 0.5d0*(e1p3-skl2)-cs(3)*e3
              t1lc6= 0.5d0*(e1p3-skl2)-omtw+ss(4)*e4
              t1uc1= cs(1)*e1 
              t1uc2= tw-ss(2)*e2
              t1uc3= cs(3)*e3-(omtw-0.5d0*(1.d0+sdmu+skl3))
              t1uc4= -ss(4)*e4+0.5d0*(1.d0+sdmu+skl3)
              t1uc5= 0.5d0*(e1p3+skl2)-ss(3)*e3
              t1uc6= 0.5d0*(e1p3+skl2)-omtw+cs(4)*e4
              t1lc= dmax1(t1lc1,t1lc2,t1lc3,t1lc4,t1lc5,t1lc6)
              t1uc= dmin1(t1uc1,t1uc2,t1uc3,t1uc4,t1uc5,t1uc6)
              at1l= dmax1(t1lp,t1lc)
              at1u= dmin1(t1up,t1uc)
           else
              at1l= t1lp
              at1u= t1up
           endif
*
*-----limits on t1 from E
*
           if(ieq.eq.1) then
              at1le= tw-bxe*e2+bl(2)
              at1ue= bxe*e1-bl(1)
              if(xdf.gt.0.d0) then
                 t1le= at1le
                 t1ue= at1ue
              else
                 t1le= at1ue
                 t1ue= at1le
              endif
              at1l= dmax1(at1l,t1le)
              at1u= dmin1(at1u,t1ue)
           endif
*
*-----positivity of (R')^2 / reality of roots for t3
* 
           rp0= e1p2*e1p2-4.d0*sm
           if(rp0.le.0.d0) then 
              iz= 0 
              ifz(31)= ifz(31)+1
              go to 2
           endif
           srp0= sqrt(rp0)
           rp0e= -rp0 
           rp1= (e1*e1p2-2.d0*sm)*tw-sm*e1m2
           rp1e= 2.d0*rp1
           rp2= -(e1*tw-sm)*(e1*tw-sm)
           ifct= 1
           call c02ajf(rp0e,rp1e,rp2,ret1,ret2,ifct)
           if(ifct.eq.1) then 
              sret1= ret1(1)
              if(rp1e.gt.0.d0) then
                 t1l= dmax1(at1l,sret1) 
                 t1u= at1u
              else if(rp1e.lt.0.d0) then
                 t1l= at1l
                 t1u= dmin1(at1u,sret1)
              endif 
           else if(ifct.gt.1.or.ret1(2).ne.0.d0) then 
              iz= 0 
              ifz(32)= ifz(32)+1
              go to 2 
           else
              rpds= 0.5d0*rp0*(ret2(1)-ret1(1)) 
              t1l= dmax1(at1l,ret1(1))
              t1u= dmin1(at1u,ret2(1))
           endif
* 
*-----test on t1
* 
           if(t1u.le.t1l) then
              iz= 0  
              ifz(33)= ifz(33)+1
              go to 2 
           endif
*
           sr= 1.d0-sm-sp-su-sd-sf
           desp= 1.d0-2.d0*(xm+xp)-(xm-xp)*(xm-xp)
           desd= -1.d0+3.d0*(xm+xp)+2.d0*(xm-xp)*(xm-xp)
           desu= -desp+1.d0-xm-xp 
           desr= -desu+1.d0-xm-xp
           dt1= xp*(5.d0-2.d0*xm+2.d0*xp)-1.d0
           de1= dt1-1.d0+xm*(5.d0+2.d0*xm-2.d0*xp)
           xmas= 1.d0+rmu2
           if(itc.eq.10) then
              t1= ep1*(1.d0-dist)/(xm+xp+(xm-xp)*dist)
              if(t1.lt.t1l.or.t1.gt.t1u) then
                 iz= 0
                 ifz(34)= ifz(34)+1 
                 go to 2
              endif
              t1jc= 2.d0*vv*e1/(xm+xp+(xm-xp)*dist)**2
              ojc= t1*(rp0e*t1+rp1e)+rp2
              t1jc= t1jc/sqrt(ojc)
           else if(itc.eq.13) then
              t1= 2.d0*arrinv(7)/uv
              if(t1.lt.t1l.or.t1.gt.t1u) then
                 iz= 0
                 ifz(34)= ifz(34)+1
                 go to 2
              endif
              t1jc= 2.d0*xp/sh
              ojc= t1*(rp0e*t1+rp1e)+rp2
              t1jc= t1jc/sqrt(ojc)
           else 
*
*-----Angular peak with
*
              if(opeaka.eq.'y') then
                  if(opeakas.eq.'i') then
                   taul= 1.d0/(e1-t1l)
                   tauu= 1.d0/(e1-t1u)
                   taumx= dmax1(taul,tauu)
                   taumn= dmin1(taul,tauu)
                   t1jc0= taumx-taumn 
                   t1= e1-1.d0/(t1jc0*t1x+taumn)
                   ojc= t1*(rp0e*t1+rp1e)+rp2 
                   if(ojc.le.0.d0) then 
                      iz= 0
                      ifz(36)= ifz(36)+1
                      go to 2
                   endif
                   t1jc= t1jc0/sqrt(ojc)
                  else if(opeakas.eq.'l') then 
                   taul0= e1-t1l 
                   tauu0= e1-t1u
                   if(taul0.le.0.d0.or.tauu0.le.0.d0) then
                      iz= 0
                      ifz(36)= ifz(36)+1
                      go to 2
                   endif
                   taul= -log(taul0)
                   tauu= -log(tauu0)
                   taumx= dmax1(taul,tauu)
                   taumn= dmin1(taul,tauu)
                   t1jc0= taumx-taumn 
                   t1exp= t1jc0*t1x+taumn 
                   t1= e1-exp(-t1exp) 
                   ojc= t1*(rp0e*t1+rp1e)+rp2
                   if(ojc.le.0.d0) then
                      iz= 0
                      ifz(36)= ifz(36)+1
                      go to 2 
                   endif
                   t1jc= t1jc0/sqrt(ojc)*exp(t1exp)
                  endif 
              else if(opeaka.eq.'f') then 
                 t1jc0= t1u-t1l
                 t1= t1jc0*t1x+t1l
                 ojc= t1*(rp0e*t1+rp1e)+rp2 
                 if(ojc.le.0.d0) then 
                    iz= 0
                    ifz(37)= ifz(37)+1
                    go to 2
                 endif
                 t1jc= t1jc0/sqrt(ojc)
              else if(opeaka.eq.'n') then
*
*-----transformation for jacobian 
* 
              if(rp0e.eq.0.d0) then 
                 taul= 2.d0/rp1e*sqrt(rp1e*t1l+rp2)
                 taut= 2.d0/rp1e*sqrt(rp1e*t1u+rp2)  
                 t1jc= taut-taul
                 t1= 0.25d0*rp1e*(t1jc*t1x+taul)**2-rp2/rp1e
              endif 
              if(ret1(1).eq.t1l) then
                 at1tl= -pih/srp0 
              else
                 bt1tl= 1.d0+rp0/rpds*(ret1(1)-t1l)
                 ifas= 1
                 at1tl= -s09aaf(bt1tl,ifas)/srp0
                 if(ifas.ne.0) print 200
              endif
              if(ret2(1).eq.t1u) then  
                 at1tu= pih/srp0
              else
                 bt1tu= -1.d0+rp0/rpds*(ret2(1)-t1u)
                 ifas= 1
                 at1tu= -s09aaf(bt1tu,ifas)/srp0
                 if(ifas.ne.0) print 200
              endif
              if((at1tl+at1tu).eq.0.d0) then
                 if(t1x.lt.1.d-3) then
                    arc= pi*t1x
                    arc2= arc*arc
                    exc= arc2*(exc2+arc2*(exc4+arc2*(exc6+
     #                   arc2*(exc8+arc2*exc10))))
                    t1= ret1(1)+0.5d0*(ret1(1)-ret2(1))*exc
                 else if((1.d0-t1x).lt.1.d-3) then
                    arc= pi*(1.d0-t1x)
                    arc2= arc*arc
                    exc= arc2*(exc2+arc2*(exc4+arc2*(exc6+
     #                   arc2*(exc8+arc2*exc10))))
                    t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc
                 else if((1.d0-t1x).lt.1.d-3) then
                    arc= pi*(1.d0-t1x)
                    arc2= arc*arc
                    exc= arc2*(exc2+arc2*(exc4+arc2*(exc6+
     #                   arc2*(exc8+arc2*exc10))))
                    t1= ret2(1)-0.5d0*(ret1(1)-ret2(1))*exc 
                 else
                    carc= cos(pi*t1x)
                    t1= 0.5d0*(ret1(1)+ret2(1))+
     #                  0.5d0*(ret1(1)-ret2(1))*carc
                 endif
                 t1jc= pi/srp0
              else
                 t1tl= dmin1(at1tl,at1tu) 
                 t1tu= dmax1(at1tl,at1tu)  
                 t1jc= t1tu-t1tl
                 t1t= t1jc*t1x+t1tl 
                 t1= (rp1+rpds*sin(srp0*t1t))/rp0 
              endif 
           endif
           endif
  200      format(' Unsuccesful call to S09AF ') 
           t1s= t1*t1 
* 
*-----test on t1 from FS 
*
           if(ieq.eq.1.and.iac(4).ne.0.d0) then
              cnlct1= xp*(xm*sm-ep12*cg12)+xp*xdf*
     #                e1*cg12*tw+xdf*cg12*t1*(xp*(e2-e1)-
     #                xdf*tw)+xdfs*cg12*t1s
               cnlst1= xp*(ep12*sg12-xm*sm)-xp*xdf*
     #                 e1*sg12*tw+xdf*sg12*t1*(xp*e1m2+
     #                 xdf*tw)-xdfs*sg12*t1s
               if(cnlct1.lt.0.d0) then
                  iz= 0
                  ifz(38)= ifz(38)+1
                  go to 2
               else if(cnlst1.lt.0.d0) then 
                  iz= 0
                  ifz(39)= ifz(39)+1
                  go to 2 
               endif
           endif
* 
*-----some vector components
*
          t2= tw-t1 
          t2s= t2*t2
*
          edn1= ep1-xdf*t1
          edn2= ep2-xdf*t2
* 
      if(otype.eq.'cc20'.and.ofl.eq.'c') then
*
         x23h= (e1-t1)*sh
         p223r= x23h
         p223i= 0.d0
         call wtopole(p223r,p223i,p3q23,fz23,fw23) 
         xg230= 1.d0/8.d0/gf/wm2
         xg23r= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+
     #          p3qw(1)-p3q23(1))
         xg23i= -0.5d0*ccw*p3q23(2)
         agr23= xg230*xg23r 
         agi23= xg230*xg23i
         if(abs(agi23).gt.1.d-20) then
            print*,' g(t) complex '
            stop
         endif
         gr23= 1.d0/agr23 
         call wtopoleg(p223r,p223i,pggf23,pgglq23,pggnp23)
         are23= ali-0.25d0*(pggf23(1)-pggf0+pggnp23)/pi 
         ai23= -0.25d0*(pggf23(2)+pgglq23(2))/pi
         if(abs(ai23).gt.1.d-20) then
            print*,' alpha(t) complex '
            stop
         endif
         er23= 4.d0*pi/are23
         str23= er23*agr23
         ctr23= 1.d0-str23
         pr23r= x23h+sz(1)
         pr23i= sz(2)
         pr23m= pr23r*pr23r+pr23i*pr23i 
         pr23ri= pr23r/pr23m
         pr23ii= -pr23i/pr23m 
         ratgr= gr23*agrsz
         ratgi= gr23*agisz
         ratcr= ctrrsz/ctr23
         ratci= ctrisz/ctr23
         ratgc= gr23/ctr23
         ratr= 1.d0-ratgr*ratcr+ratgi*ratci 
         rati= -ratgr*ratci-ratgi*ratcr
         arhr23= x23h+sz(1)-ratr*sz(1)+rati*sz(2)-ratgc*(fz23(1)-
     #           fzsz(1))/apis
         arhi23= sz(2)-ratr*sz(2)-rati*sz(1)-ratgc*(fz23(2)-
     #           fzsz(2))/apis
         brhr23= arhr23*pr23ri-arhi23*pr23ii
         brhi23= arhr23*pr23ii+arhi23*pr23ri
         brhm23= brhr23*brhr23+brhi23*brhi23
         rhr23= brhr23/brhm23 
         rhi23= -brhi23/brhm23
*
         x14h= t2*sh
         p214r= x14h
  
         p214i= 0.d0
         call wtopole(p214r,p214i,p3q14,fz14,fw14) 
         xg140= 1.d0/8.d0/gf/wm2
         xg14r= 1.d0+0.5d0*ccw*((fw0-fw(1))/wm2+
     #          p3qw(1)-p3q14(1))
         xg14i= -0.5d0*ccw*p3q14(2)
         agr14= xg140*xg14r
         agi14= xg140*xg14i 
         if(abs(agi14).gt.1.d-20) then
            print*,' g(t) complex ' 
            stop
         endif
         gr14= 1.d0/agr14 
         p14r= x14h+sw(1)
         pr14ri= p14r/(p14r*p14r+swis)
         pr14ii= -sw(2)/(p14r*p14r+swis) 
         rat14r= 1.d0-gr14*agrsw
         rat14i= -gr14*agisw
         arhr14= x14h+sw(1)-rat14r*sw(1)+rat14i*sw(2)-gr14* 
     #           (fw14(1)-fwsw(1))/apis 
         arhi14= sw(2)-rat14r*sw(2)-rat14i*sw(1)-gr14*
     #           (fw14(2)-fwsw(2))/apis 
         brhr14= arhr14*pr14ri-arhi14*pr14ii
         brhi14= arhr14*pr14ii+arhi14*pr14ri
         brh14m= brhr14*brhr14+brhi14*brhi14
         rhr14= brhr14/brh14m 
         rhi14= -brhi14/brh14m
*
      endif 
* 
      if(otype.eq.'cc20'.and.ofl.eq.'c') then 
         jfl= 1 
         p1s= t2*sh 
         p2s= -sph
         ps= (e1-t1)*sh 
         rm12= rnm2
         rm22= rnm2
         rm32= rnm2 
         call wtocff(jfl,p1s,p2s,ps,rm12,rm22,rm32,
     #               ec00,ec01,ec02,ec03) 
         jfl= 1
         p1s= t2*sh
         p2s= -sph
         ps= (e1-t1)*sh
         rm12= rnm2
         rm22= tqm2 
         rm32= rnm2 
         call wtocff(jfl,p1s,p2s,ps,rm12,rm22,rm32, 
     #               eca0,eca1,eca2,eca3) 
         jfl= 1
         p1s= t2*sh 
         p2s= -sph
         ps= (e1-t1)*sh
         rm12= tqm2 
         rm22= rnm2
         rm32= tqm2 
         call wtocff(jfl,p1s,p2s,ps,rm12,rm22,rm32, 
     #               ecb0,ecb1,ecb2,ecb3)
*
         do i=1,2
          do j=1,6
           ecp3(i,j)= eca3(i,j)+2.d0*ecb3(i,j)
           ecm3(i,j)= eca3(i,j)-2.d0*ecb3(i,j)
           ecc3(i,j)= ecp3(i,j)-3.d0*ec03(i,j)
          enddo    
          do j=1,4
           ecp2(i,j)= eca2(i,j)+2.d0*ecb2(i,j)
           ecm2(i,j)= eca2(i,j)-2.d0*ecb2(i,j)
           ecc2(i,j)= ecp2(i,j)-3.d0*ec02(i,j)
          enddo    
          do j=1,2
           ecp1(i,j)= eca1(i,j)+2.d0*ecb1(i,j)
           ecm1(i,j)= eca1(i,j)-2.d0*ecb1(i,j)
           ecc1(i,j)= ecp1(i,j)-3.d0*ec01(i,j)
          enddo     
          ecp0(i)= eca0(i)+2.d0*ecb0(i)
          ecm0(i)= eca0(i)-2.d0*ecb0(i)
          ecc0(i)= ecp0(i)-3.d0*ec00(i) 
         enddo
         xg= (e1-t1)*sh
         xw= t2*sh
* 
         do i=1,2
*
      h1(i)= xg*(16*ec03(i,3)-16*ec03(i,4)-16*ec02(i,2)
     #  -16*ec01(i,2))
      h1(i)= h1(i)+xw*(16*ec03(i,1)-32*ec03(i,3)+16*ec03(i,4)
     #  +16*ec02(i,1)+16*ec02(i,2)-32*ec02(i,3))
      h1(i)= h1(i)+sph*(16*ec03(i,2)+16*ec03(i,3)-32*ec03(i,4))
      h1(i)= h1(i)+(32*ec03(i,5)-32*ec03(i,6)-32*ec02(i,4))
      h1(i)= h1(i)+32.d0/3.d0*co(i)
*
      h2(i)= xg*(-24*ec03(i,3)+24*ec03(i,4)+24*ec02(i,2)
     #  -16*ec02(i,3)+8*ec01(i,2))
      h2(i)= h2(i)+xw*(-24*ec03(i,1)+48*ec03(i,3)-24*ec03(i,4)
     #  -40*ec02(i,1)-24*ec02(i,2)+64*ec02(i,3)-16*ec01(i,1)+
     #  16*ec01(i,2))
      h2(i)= h2(i)+sph*(-24*ec03(i,2)-24*ec03(i,3)+48*ec03(i,4)
     #  +16*ec02(i,2)-16*ec02(i,3))
      h2(i)= h2(i)+(-48*ec03(i,5)+48*ec03(i,6)-16*ec02(i,4))
*
      h3(i)= xg*(-8*ec03(i,3)-8*ec03(i,4)-8*ec02(i,2)
     #  -16*ec02(i,3)-8*ec01(i,2))
      h3(i)= h3(i)+xw*(-8*ec03(i,1)+8*ec03(i,4)-8*ec02(i,1)
     #  +8*ec02(i,2))
      h3(i)= h3(i)+sph*(8*ec03(i,2)-8*ec03(i,3)+16*ec02(i,2)-16*
     #  ec02(i,3))
      h3(i)= h3(i)+(-16*ec03(i,5)-16*ec03(i,6)-16*ec02(i,4))
*
      h4(i)= 64*ec03(i,3)-64*ec03(i,4)-64*ec02(i,2)+64*ec02(i,3)
      h4(i)= sh*h4(i)
*
      ht1(i)= tqm2*(-2*ecp1(i,1)+2*ecp1(i,2)-2*ecp0(i)
     #  +2*ecm1(i,1)-2*ecm1(i,2)+2*ecm0(i))
      ht1(i)= ht1(i)+xg*(4*ecc3(i,3)-4*ecc3(i,4)-4*ecc2(i,2)
     #  -4*ecc1(i,2))
      ht1(i)= ht1(i)+xw*(4*ecc3(i,1)-8*ecc3(i,3)+4*ecc3(i,4)
     #  +4*ecc2(i,1)+4*ecc2(i,2)-8*ecc2(i,3))
      ht1(i)= ht1(i)+sph*(4*ecc3(i,2)+4*ecc3(i,3)-8*ecc3(i,4))
      ht1(i)= ht1(i)+(8*ecc3(i,5)-8*ecc3(i,6)-8*ecc2(i,4))
*
      ht2(i)= tqm2*(ecp1(i,1)-ecp1(i,2)+ecp0(i)-ecm1(i,1)
     #  +ecm1(i,2)-ecm0(i))
      ht2(i)= ht2(i)+xg*(-6*ecc3(i,3)+6*ecc3(i,4)+6*ecc2(i,2)
     #  -4*ecc2(i,3)+2*ecc1(i,2))
      ht2(i)= ht2(i)+xw*(-6*ecc3(i,1)+12*ecc3(i,3)-6*ecc3(i,4)
     #  -10*ecc2(i,1)-6*ecc2(i,2)+16*ecc2(i,3)-4*ecc1(i,1)+4*
     #  ecc1(i,2))
      ht2(i)= ht2(i)+sph*(-6*ecc3(i,2)-6*ecc3(i,3)+12*ecc3(i,4)
     #  +4*ecc2(i,2)-4*ecc2(i,3))
      ht2(i)= ht2(i)+(-12*ecc3(i,5)+12*ecc3(i,6)-4*ecc2(i,4))
*
      ht3(i)= tqm2*(-ecp1(i,1)-ecp1(i,2)-ecp0(i)+
     #  ecm1(i,1)+ecm1(i,2)+ecm0(i))
      ht3(i)= ht3(i)+xg*(-2*ecc3(i,3)-2*ecc3(i,4)-2*ecc2(i,2)
     #  -4*ecc2(i,3)-2*ecc1(i,2))
      ht3(i)= ht3(i)+xw*(-2*ecc3(i,1)+2*ecc3(i,4)-2*ecc2(i,1)
     #  +2*ecc2(i,2))
      ht3(i)= ht3(i)+sph*(2*ecc3(i,2)-2*ecc3(i,3)+4*ecc2(i,2)-4*
     #  ecc2(i,3))
      ht3(i)= ht3(i)+(-4*ecc3(i,5)-4*ecc3(i,6)-4*ecc2(i,4))
*
      ht4(i)= 16*ecc3(i,3)-16*ecc3(i,4)-16*ecc2(i,2)+16*ecc2(i,3)
      ht4(i)= sh*ht4(i)
*
      if(rio.eq.'i') then
         ht5(i)= 0.d0
         ht6(i)= 0.d0
      else if(rio.eq.'a') then
*
      ht5(i)= tqm2*(-2*ecp1(i,1)-2*ecp1(i,2)-2*ecp0(i)+
     #  2*ecm1(i,1)+2*ecm1(i,2)+2*ecm0(i))
      ht5(i)= ht5(i)+xg*(4./3.*ecp3(i,3)+4./3.*ecp3(i,4)-4./3.
     #  *ecp2(i,2)+16./3.*ecp2(i,3)+4./3.*ecp1(i,1)+4*ecm3(i,3)+4
     #  *ecm3(i,4)-4*ecm2(i,2)+16*ecm2(i,3)+4*ecm1(i,1)-4./3.*
     #  ecc3(i,3)-4./3.*ecc3(i,4)+4./3.*ecc2(i,2)-16./3.*ecc2(i,3)
     #  -4./3.*ecc1(i,1))
      ht5(i)= ht5(i)+xw*(4./3.*ecp3(i,1)-4./3.*ecp3(i,4)+4*
     #  ecp2(i,1)+4./3.*ecp2(i,2)-16./3.*ecp2(i,3)+4./3.*ecp1(i,1)
     #  -4./3.*ecp1(i,2)+4*ecm3(i,1)-4*ecm3(i,4)+12*ecm2(i,1)+4
     #  *ecm2(i,2)-16*ecm2(i,3)+4*ecm1(i,1)-4*ecm1(i,2)-4./3.*
     #  ecc3(i,1)+4./3.*ecc3(i,4)-4*ecc2(i,1)-4./3.*ecc2(i,2)+16./
     #  3.*ecc2(i,3)-4./3.*ecc1(i,1)+4./3.*ecc1(i,2))
      ht5(i)= ht5(i)+sph*(-4./3.*ecp3(i,2)+4./3.*ecp3(i,3)-8./3.
     #  *ecp2(i,2)+8./3.*ecp2(i,3)+4./3.*ecp1(i,1)-4./3.*ecp1(i,2)
     #  -4*ecm3(i,2)+4*ecm3(i,3)-8*ecm2(i,2)+8*ecm2(i,3)+4*ecm1(i,1)
     #  -4*ecm1(i,2)+4./3.*ecc3(i,2)-4./3.*ecc3(i,3)+8./3.*
     #  ecc2(i,2)-8./3.*ecc2(i,3)-4./3.*ecc1(i,1)+4./3.*ecc1(i,2))
      ht5(i)= ht5(i)+(8*ecp3(i,5)+8*ecp3(i,6)+8*ecp2(i,4)+24*
     #  ecm3(i,5)+24*ecm3(i,6)+24*ecm2(i,4)-8*ecc3(i,5)-8*ecc3(i,6)
     #  -8*ecc2(i,4))
*
      ht6(i)= tqm2*(2*ecp1(i,1)-2*ecp1(i,2)+2*ecp0(i)
     #  -2*ecm1(i,1)+2*ecm1(i,2)-2*ecm0(i))
      ht6(i)= ht6(i)+xg*(-4./3.*ecp3(i,3)+4./3.*ecp3(i,4)-4.
     #  /3.*ecp2(i,2)+4./3.*ecp1(i,1)-8./3.*ecp1(i,2)-4*ecm3(i,3)
     #  +4*ecm3(i,4)-4*ecm2(i,2)+4*ecm1(i,1)-8*ecm1(i,2)+4./3.*
     #  ecc3(i,3)-4./3.*ecc3(i,4)+4./3.*ecc2(i,2)-4./3.*ecc1(i,1)
     #  +8./3.*ecc1(i,2))
      ht6(i)= ht6(i)+xw*(-4./3.*ecp3(i,1)+8./3.*ecp3(i,3)-4.
     #  /3.*ecp3(i,4)-4./3.*ecp2(i,1)+4./3.*ecp2(i,2)-4./3.*ecp1(i,1)
     #  +4./3.*ecp1(i,2)-4*ecm3(i,1)+8*ecm3(i,3)-4*ecm3(i,4)-
     #  4*ecm2(i,1)+4*ecm2(i,2)-4*ecm1(i,1)+4*ecm1(i,2)+4./3.*
     #  ecc3(i,1)-8./3.*ecc3(i,3)+4./3.*ecc3(i,4)+4./3.*ecc2(i,1)
     #  -4./3.*ecc2(i,2)+4./3.*ecc1(i,1)-4./3.*ecc1(i,2))
      ht6(i)= ht6(i)+sph*(-4./3.*ecp3(i,2)-4./3.*ecp3(i,3)+8./3.
     #  *ecp3(i,4)-8./3.*ecp2(i,2)+8./3.*ecp2(i,3)+4./3.*ecp1(i,1)
     #  -4./3.*ecp1(i,2)-4*ecm3(i,2)-4*ecm3(i,3)+8*ecm3(i,4)-8*
     #  ecm2(i,2)+8*ecm2(i,3)+4*ecm1(i,1)-4*ecm1(i,2)+4./3.*ecc3(i,2)
     #  +4./3.*ecc3(i,3)-8./3.*ecc3(i,4)+8./3.*ecc2(i,2)-8./3.
     #  *ecc2(i,3)-4./3.*ecc1(i,1)+4./3.*ecc1(i,2))
      ht6(i)= ht6(i)+(-8*ecp3(i,5)+8*ecp3(i,6)-8./3.*ecp2(i,4)
     #  -24*ecm3(i,5)+24*ecm3(i,6)-8*ecm2(i,4)+8*ecc3(i,5)-8*
     #  ecc3(i,6)+8./3.*ecc2(i,4))
*
      endif
*
      htz1(i)= tqm2*(4*ecp1(i,1)-4*ecp1(i,2)+4*ecp0(i)
     #  -4*ecm1(i,1)+4*ecm1(i,2)-4*ecm0(i))
      htz1(i)= htz1(i)+xg*(ecp3(i,3)-ecp3(i,4)-ecp2(i,2)-ecp1(i,2)
     #  +3*ecm3(i,3)-3*ecm3(i,4)-3*ecm2(i,2)-3*ecm1(i,2))
      htz1(i)= htz1(i)+xw*(ecp3(i,1)-2*ecp3(i,3)+ecp3(i,4)+
     #  ecp2(i,1)+ecp2(i,2)-2*ecp2(i,3)+3*ecm3(i,1)-6*ecm3(i,3)+
     #  3*ecm3(i,4)+3*ecm2(i,1)+3*ecm2(i,2)-6*ecm2(i,3))
      htz1(i)= htz1(i)+sph*(ecp3(i,2)+ecp3(i,3)-2*ecp3(i,4)+3*ecm3(i,2)
     #  +3*ecm3(i,3)-6*ecm3(i,4))
      htz1(i)= htz1(i)+(2*ecp3(i,5)-2*ecp3(i,6)-2*ecp2(i,4)+6*
     #  ecm3(i,5)-6*ecm3(i,6)-6*ecm2(i,4))
*
      htz2(i)= tqm2*(-2*ecp1(i,1)+2*ecp1(i,2)-2*ecp0(i)+
     #  2*ecm1(i,1)-2*ecm1(i,2)+2*ecm0(i))
      htz2(i)= htz2(i)+xg*(-3./2.*ecp3(i,3)+3./2.*ecp3(i,4)+3.
     #  /2.*ecp2(i,2)-ecp2(i,3)+1./2.*ecp1(i,2)-9./2.*ecm3(i,3)+9.
     #  /2.*ecm3(i,4)+9./2.*ecm2(i,2)-3*ecm2(i,3)+3./2.*ecm1(i,2))
      htz2(i)= htz2(i)+xw*(-3./2.*ecp3(i,1)+3*ecp3(i,3)-3./2.
     #  *ecp3(i,4)-5./2.*ecp2(i,1)-3./2.*ecp2(i,2)+4*ecp2(i,3)-
     #  ecp1(i,1)+ecp1(i,2)-9./2.*ecm3(i,1)+9*ecm3(i,3)-9./2.*
     #  ecm3(i,4)-15./2.*ecm2(i,1)-9./2.*ecm2(i,2)+12*ecm2(i,3)-3
     #  *ecm1(i,1)+3*ecm1(i,2))
      htz2(i)= htz2(i)+sph*(-3./2.*ecp3(i,2)-3./2.*ecp3(i,3)+3*
     #  ecp3(i,4)+ecp2(i,2)-ecp2(i,3)-9./2.*ecm3(i,2)-9./2.*ecm3(i,3)
     #  +9*ecm3(i,4)+3*ecm2(i,2)-3*ecm2(i,3))
      htz2(i)= htz2(i)+(-3*ecp3(i,5)+3*ecp3(i,6)-ecp2(i,4)-9*
     #  ecm3(i,5)+9*ecm3(i,6)-3*ecm2(i,4))
*
      htz3(i)= tqm2*(2*ecp1(i,1)+2*ecp1(i,2)+2*ecp0(i)
     #  -2*ecm1(i,1)-2*ecm1(i,2)-2*ecm0(i))
      htz3(i)= htz3(i)+xg*(-1./2.*ecp3(i,3)-1./2.*ecp3(i,4)-1.
     #  /2.*ecp2(i,2)-ecp2(i,3)-1./2.*ecp1(i,2)-3./2.*ecm3(i,3)-3.
     #  /2.*ecm3(i,4)-3./2.*ecm2(i,2)-3*ecm2(i,3)-3./2.*ecm1(i,2))
      htz3(i)= htz3(i)+xw*(-1./2.*ecp3(i,1)+1./2.*ecp3(i,4)-1.
     #  /2.*ecp2(i,1)+1./2.*ecp2(i,2)-3./2.*ecm3(i,1)+3./2.*ecm3(i,
     #  4)-3./2.*ecm2(i,1)+3./2.*ecm2(i,2))
      htz3(i)= htz3(i)+sph*(1./2.*ecp3(i,2)-1./2.*ecp3(i,3)+ecp2(i,2)
     #  -ecp2(i,3)+3./2.*ecm3(i,2)-3./2.*ecm3(i,3)+3*ecm2(i,2)
     #  -3*ecm2(i,3))
      htz3(i)= htz3(i)+(-ecp3(i,5)-ecp3(i,6)-ecp2(i,4)-3*ecm3(i,5)
     #  -3*ecm3(i,6)-3*ecm2(i,4))
*
      htz4(i)= 4*ecp3(i,3)-4*ecp3(i,4)-4*ecp2(i,2)+4*
     #  ecp2(i,3)+12*ecm3(i,3)-12*ecm3(i,4)-12*ecm2(i,2)+12*ecm2(i,3)
      htz4(i)= sh*htz4(i)
*
      if(rio.eq.'i') then
         htz5(i)= 0.d0
         htz6(i)= 0.d0
      else if(rio.eq.'a') then
*
      htz5(i)= tqm2*(4*ecp1(i,1)+4*ecp1(i,2)+4*ecp0(i)
     #  -4*ecm1(i,1)-4*ecm1(i,2)-4*ecm0(i))
      htz5(i)= htz5(i)+xg*(1./3.*ecp3(i,3)+1./3.*ecp3(i,4)-1./3.
     #  *ecp2(i,2)+4./3.*ecp2(i,3)+1./3.*ecp1(i,1)+ecm3(i,3)+ecm3(i,4)
     #  -ecm2(i,2)+4*ecm2(i,3)+ecm1(i,1)+8./3.*ecc3(i,3)+8./
     #  3.*ecc3(i,4)-8./3.*ecc2(i,2)+32./3.*ecc2(i,3)+8./3.*ecc1(i,1))
      htz5(i)= htz5(i)+xw*(1./3.*ecp3(i,1)-1./3.*ecp3(i,4)
     #  +ecp2(i,1)+1./3.*ecp2(i,2)-4./3.*ecp2(i,3)+1./3.*ecp1(i,1)-1./
     #  3.*ecp1(i,2)+ecm3(i,1)-ecm3(i,4)+3*ecm2(i,1)+ecm2(i,2)-4
     #  *ecm2(i,3)+ecm1(i,1)-ecm1(i,2)+8./3.*ecc3(i,1)-8./3.*ecc3(i,4)
     #  +8*ecc2(i,1)+8./3.*ecc2(i,2)-32./3.*ecc2(i,3)+8./3.*
     #  ecc1(i,1)-8./3.*ecc1(i,2))
      htz5(i)= htz5(i)+sph*(-1./3.*ecp3(i,2)+1./3.*ecp3(i,3)-2./3.
     #  *ecp2(i,2)+2./3.*ecp2(i,3)+1./3.*ecp1(i,1)-1./3.*ecp1(i,2)
     #  -ecm3(i,2)+ecm3(i,3)-2*ecm2(i,2)+2*ecm2(i,3)+ecm1(i,1)
     #  -ecm1(i,2)-8./3.*ecc3(i,2)+8./3.*ecc3(i,3)-16./3.*ecc2(i,2)
     #  +16./3.*ecc2(i,3)+8./3.*ecc1(i,1)-8./3.*ecc1(i,2))
      htz5(i)= htz5(i)+(2*ecp3(i,5)+2*ecp3(i,6)+2*ecp2(i,4)+6*
     #  ecm3(i,5)+6*ecm3(i,6)+6*ecm2(i,4)+16*ecc3(i,5)+16*ecc3(i,6)
     #  +16*ecc2(i,4))
*
      htz6(i)= tqm2*(-4*ecp1(i,1)+4*ecp1(i,2)-4*ecp0(i)
     #  +4*ecm1(i,1)-4*ecm1(i,2)+4*ecm0(i))
      htz6(i)= htz6(i)+xg*(-1./3.*ecp3(i,3)+1./3.*ecp3(i,4)-1.
     #  /3.*ecp2(i,2)+1./3.*ecp1(i,1)-2./3.*ecp1(i,2)-ecm3(i,3)+
     #  ecm3(i,4)-ecm2(i,2)+ecm1(i,1)-2*ecm1(i,2)-8./3.*ecc3(i,3)
     #  +8./3.*ecc3(i,4)-8./3.*ecc2(i,2)+8./3.*ecc1(i,1)-16./3.*
     #  ecc1(i,2))
      htz6(i)= htz6(i)+xw*(-1./3.*ecp3(i,1)+2./3.*ecp3(i,3)-1.
     #  /3.*ecp3(i,4)-1./3.*ecp2(i,1)+1./3.*ecp2(i,2)-1./3.*ecp1(i,1)
     #  +1./3.*ecp1(i,2)-ecm3(i,1)+2*ecm3(i,3)-ecm3(i,4)-ecm2(i,1)
     #  +ecm2(i,2)-ecm1(i,1)+ecm1(i,2)-8./3.*ecc3(i,1)+16./
     #  3.*ecc3(i,3)-8./3.*ecc3(i,4)-8./3.*ecc2(i,1)+8./3.*ecc2(i,2)
     #  -8./3.*ecc1(i,1)+8./3.*ecc1(i,2))
      htz6(i)= htz6(i)+sph*(-1./3.*ecp3(i,2)-1./3.*ecp3(i,3)+2./3.
     #  *ecp3(i,4)-2./3.*ecp2(i,2)+2./3.*ecp2(i,3)+1./3.*ecp1(i,1)
     #  -1./3.*ecp1(i,2)-ecm3(i,2)-ecm3(i,3)+2*ecm3(i,4)-2*ecm2(i,2)
     #  +2*ecm2(i,3)+ecm1(i,1)-ecm1(i,2)-8./3.*ecc3(i,2)-8./
     #  3.*ecc3(i,3)+16./3.*ecc3(i,4)-16./3.*ecc2(i,2)+16./3.*ecc2(i,3)
     #  +8./3.*ecc1(i,1)-8./3.*ecc1(i,2))
      htz6(i)= htz6(i)+(-2*ecp3(i,5)+2*ecp3(i,6)-2./3.*ecp2(i,4)
     #  -6*ecm3(i,5)+6*ecm3(i,6)-2*ecm2(i,4)-16*ecc3(i,5)+16*
     #  ecc3(i,6)-16./3.*ecc2(i,4))
      endif
*
         enddo
      endif 
* 
*-----equation for xi is solved 
*
             if(itc.ne.13) then 
              e1s= e1*e1
              e2s= e2*e2
              e3s= e3*e3
              e12= e1t2-2.d0*sm
              e13= e1t3-2.d0*sf 
              e23= e2t3-2.d0*su 
              e12s= e12*e12 
              e13s= e13*e13
              e23s= e23*e23
             xia= e1s*e2s-e12s
             xib= 2.d0*t1*(e2s*e13-e12*e23)+2.d0*t2*(e1s*e23-
     #            e12*e13)-e1*e2s*e13+e1*e12*e23-e1s*e2*e23+
     #            e2*e12*e13
             xic= 8.d0*t1*t2*(-e3s*e12+e13*e23)+4.d0*t1*(-e1*
     #            e2s*e3s+e1*e23s+e2*e3s*e12-e2*e13*e23)+4.d0*
     #            t1s*(e2s*e3s-e23s)+4.d0*t2*(e1*e3s*e12-e1*
     #            e13*e23-e1s*e2*e3s+e2*e13s)+4.d0*t2*t2*(e1s*
     #            e3s-e13s)-2.d0*e1t2*e3s*e12+2.d0*e1t2*e13*
     #            e23+e1s*e2s*e3s+e3s*e12s-2.d0*e12*e13*e23
              xib= 2.d0*xib 
              ifc0= 1
              call c02ajf(xia,xib,xic,rtm,rtp,ifc0)  
              if(ifc0.eq.0) then
                 ixia= 1
              else if(ifc0.eq.1) then 
                 rtp(1)= rtm(1) 
                 rtp(2)= rtm(2) 
                 ixia= 0
              else if(ifc0.gt.1) then 
                 iz= 0
                 ifz(40)= ifz(40)+1
                 go to 2
              endif
              if(rtm(2).ne.0.d0) then 
                 iz= 0
                 ifz(41)= ifz(41)+1
                 go to 2
              endif 
*  
*-----xi^+ and xi^- are computed
* 
              xip= 0.5d0*(e3-rtp(1))
              xim= 0.5d0*(e3-rtm(1))
             endif
*
*-----each integral becomes a sum of two terms
*
*-----loop over ix starts here
*
         if(itc.eq.13) then
            ixmn= 1 
            ixmx= 1         
         else if(om.eq.'g') then
             ixmn= ix0
             ixmx= ix0
         else
             ixmn= 1
             ixmx= 2
         endif
*
          do ix=ixmn,ixmx
*
*-----q_3 is compared and x15 is selected 
* 
                     if(ix.eq.1) then
                        if(itc.eq.13) then
                           t3= 2.d0*arrinv(9)/vv
                        else
                           t3= xip
                        endif 
                     else if(ix.eq.2) then
                        t3= xim
                     endif
* 
*-----The two integrands are computed
*
*-----further auxiliary quantities
*
               t4= omtw-t3
               edn3= ep3-xdf*t3 
               edn4= ep4-xdf*t4 
*
*-----collections of all limits on t3
*
*-----from energy (or natural limits)
* 
               if(ieq.eq.1) then
                  at3l1= omtw-bxe*e4+bl(4)
                  at3u1= bxe*e3-bl(3)

                  if(xdf.gt.0.d0) then 
                     t3l1= at3l1 
                     t3u1= at3u1
                  else if(xdf.lt.0.d0) then 
                     t3l1= at3u1 
                     t3u1= at3l1
                  endif 
               else 
                  t3l1= 0.d0
                  t3u1= e3
               endif
*
*-----natural limits
*
                   t3l2= -t1+0.5d0*(e1p3-skl2)
                   t3u2= -t1+0.5d0*(e1p3+skl2)
                   t3l3= omtw+t1-0.5d0*(1.d0+sdmu+skl3)
                   t3u3= omtw+t1-0.5d0*(1.d0+sdmu-skl3)
*
*-----from positivity on SA
*
                   t3l4= 0.d0
                   t3l5= sm+su+sf-tw
                   t3u4= sp+su+sf 
                   t3u5= omtw
*
*-----from SA
*
                   if(iac(3).ne.0) then
                     t3l6= ss(3)*e3
                     t3u6= cs(3)*e3
                     t3l7= omtw-cs(4)*e4
                     t3u7= omtw-ss(4)*e4
                     t3l= dmax1(t3l1,t3l2,t3l3,t3l4,
     #                          t3l5,t3l6,t3l7)
                     t3u= dmin1(t3u1,t3u2,t3u3,t3u4,
     #                          t3u5,t3u6,t3u7)
                   else
                     t3l= dmax1(t3l1,t3l2,t3l3,t3l4,t3l5)
                     t3u= dmin1(t3u1,t3u2,t3u3,t3u4,t3u5)
                   endif
* 
*-----limits on t3 are imposed
*             
                   tlimt3= (t3u-t3)*(t3-t3l)
                   if(t3u.lt.t3l) then
                      iz= 0
                      ifz(42)= ifz(42)+1
                      go to 4
                   else if(tlimt3.lt.0.d0) then
                      iz= 0
                      ifz(42)= ifz(42)+1
                      go to 4
                   endif
*
*-----non linear limits on t3,t4 are imposed
*             
                   if(iac(4).ne.0.and.ieq.eq.1) then
                      tnl13c= -cg13*edn1*edn3+vv*sf
                      tnl13s= sg13*edn1*edn3-vv*sf
                      tnl23c= -cg23*edn2*edn3+vv*su
                      tnl23s= sg23*edn2*edn3-vv*su
                      tnl14c= -cg14*edn1*edn4+vv*sd
                      tnl14s= sg14*edn1*edn4-vv*sd
                      sres= 1.d0-e1-e3+sf 
                      tnl24c= -cg24*edn2*edn4+vv*sres
                      tnl24s= sg24*edn2*edn4-vv*sres
                      tnl34c= -cg34*edn3*edn4+vv*sp
                      tnl34s= sg34*edn3*edn4-vv*sp
                      if(tnl13c.lt.0.d0.or.tnl13s.lt.0.d0.or.
     #                   tnl23c.lt.0.d0.or.tnl23s.lt.0.d0.or.
     #                   tnl14c.lt.0.d0.or.tnl14s.lt.0.d0.or.
     #                   tnl24c.lt.0.d0.or.tnl24s.lt.0.d0.or.
     #                   tnl34c.lt.0.d0.or.tnl34s.lt.0.d0) then
                         iz= 0
                         ifz(43)= ifz(43)+1
                         go to 4
                      endif                
                   endif
*
*-----non linear constraints from FS  in the case xp = xm
*
                   if(iac(4).ne.0.d0.and.ieq.eq.0) then
                      smr= 1.d0-sm-sp-su-sd-sf
                      spc12= (-cg12*e1t2+sm)*(sg12*e1t2-sm) 
                      spc13= (-cg13*e1t3+sf)*(sg13*e1t3-sf) 
                      spc14= (-cg14*e1t4+sd)*(sg14*e1t4-sd)
                      spc23= (-cg23*e2t3+su)*(sg23*e2t3-su)
                      spc24= (-cg24*e2t4+smr)*(sg24*e2t4-smr)
                      spc34= (-cg34*e3t4+sp)*(sg34*e3t4-sp)
                      if(spc12.lt.0.d0.or.spc13.lt.0.d0.or.                  
     #                   spc14.lt.0.d0.or.spc23.lt.0.d0.or.                   
     #                   spc24.lt.0.d0.or.spc34.lt.0.d0) then
                         iz= 0
                         ifz(44)= ifz(44)+1
                         go to 4
                      endif
                   endif
*
*
*-----all invariants
*
                     x13= t1
                     x14= t2
                     x15= t3
                     x16= t4
                     x23= e1-t1
                     x24= e2-t2
                     x25= e3-t3
                     x26= e4-t4
                     x34= sm
                     x35= sf
                     x36= sd
                     x45= su
                     x46= 1.d0-sm-sp-su-sd-sf
                     x56= sp
*
       if(otype.eq.'cc20'.and.(ofl.eq.'c'.or.ofl.eq.'a')) then
        if(ofl.eq.'c') then
         vel23= -1.d0+2.d0*str23
         ver23= 2.d0*str23
         velr23= ver23*vel23
         vdpl23= -1.d0-2.d0*chdp*str23
         vupl23= 1.d0-2.d0*chup*str23
         gr23r= gr23/g2
         gsr23r= gr23r*str23
         app23r= (x23+rszrv)/((x23+rszrv)**2+srzis/vvs)
         app23i= -rsziv/((x23+rszrv)**2+srzis/vvs)
         pp23r= gr23/g2*(app23r*rhr23-app23i*rhi23)
         pp23i= gr23/g2*(app23r*rhi23+app23i*rhr23)
         ppl23= 0.5d0*vel23*x23*pp23r
         ppr23= 0.5d0*ver23*x23*pp23r
*
         h1gr= 3.d0*h1(1)+ht1(1)-8.d0*p3q14(1)
         h2gr= 3.d0*h2(1)+ht2(1)
         h3gr= 3.d0*h3(1)+ht3(1)
         h4gr= 3.d0*h4(1)+ht4(1)
         h5gr= ht5(1)
         h6gr= ht6(1)
         h1gi= 3.d0*h1(2)+ht1(2)
         h2gi= 3.d0*h2(2)+ht2(2)
         h3gi= 3.d0*h3(2)+ht3(2)
         h4gi= 3.d0*h4(2)+ht4(2)
         h5gi= ht5(2)
         h6gi= ht6(2)
         h1cr= h1gr+0.5d0*htz1(1)/ctr23
         h2cr= h2gr+0.5d0*htz2(1)/ctr23
         h3cr= h3gr+0.5d0*htz3(1)/ctr23
         h4cr= h4gr+0.5d0*htz4(1)/ctr23
         h5cr= h5gr+0.5d0*htz5(1)/ctr23
         h6cr= h6gr+0.5d0*htz6(1)/ctr23
         h1ci= h1gi+0.5d0*htz1(2)/ctr23
         h2ci= h2gi+0.5d0*htz2(2)/ctr23
         h3ci= h3gi+0.5d0*htz3(2)/ctr23
         h4ci= h4gi+0.5d0*htz4(2)/ctr23
         h5ci= h5gi+0.5d0*htz5(2)/ctr23
         h6ci= h6gi+0.5d0*htz6(2)/ctr23
        else if(ofl.eq.'a') then
         x23h= (e1-t1)*sh
         gsr23r= sth2
         ppl23= 0.5d0*vel*x23/(x23+rszm2)
         ppr23= 0.5d0*ver*x23/(x23+rszm2)
*
         h1gr= acg1g-0.5d0*x23h/wm2*aclg
         h2gr= 0.5d0*(acg1g+ackg)+0.5d0*(1.d0+x23h/wm2)*aclg
         h3gr= 0.d0
         h4gr= -x23h/wm2*aclg
         h5gr= 0.d0
         h6gr= -acg5g
         h1gi= 0.d0
         h2gi= 0.d0
         h3gi= 0.5d0*acg4g
         h4gi= 0.d0
         h5gi= -(acktg-acltg)
         h6gi= 0.d0
         h1cr= acg1z-0.5d0*x23h/wm2*aclz
         h2cr= 0.5d0*(acg1z+ackz)+0.5d0*(1.d0+x23h/wm2)*aclz
         h3cr= 0.d0
         h4cr= -x23h/wm2*aclz
         h5cr= 0.d0
         h6cr= -acg5z
         h1ci= 0.d0
         h2ci= 0.d0
         h3ci= 0.5d0*acg4z
         h4ci= 0.d0
         h5ci= -(acktz-acltz)
         h6ci= 0.d0
        endif
        ecv1ar= gsr23r*h1gr-ppl23*h1cr
        ecv1ai= gsr23r*h1gi-ppl23*h1ci
        ecv2ar= gsr23r*h2gr-ppl23*h2cr
        ecv2ai= gsr23r*h2gi-ppl23*h2ci
        ecv3ar= gsr23r*h3gr-ppl23*h3cr
        ecv3ai= gsr23r*h3gi-ppl23*h3ci
        ecv4ar= gsr23r*h4gr-ppl23*h4cr
        ecv4ai= gsr23r*h4gi-ppl23*h4ci
        ecv5ar= gsr23r*h5gr-ppl23*h5cr
        ecv5ai= gsr23r*h5gi-ppl23*h5ci
        ecv6ar= gsr23r*h6gr-ppl23*h6cr
        ecv6ai= gsr23r*h6gi-ppl23*h6ci
*
        ecv1er= gsr23r*h1gr-ppr23*h1cr
        ecv1ei= gsr23r*h1gi-ppr23*h1ci
        ecv2er= gsr23r*h2gr-ppr23*h2cr
        ecv2ei= gsr23r*h2gi-ppr23*h2ci
        ecv3er= gsr23r*h3gr-ppr23*h3cr
        ecv3ei= gsr23r*h3gi-ppr23*h3ci
        ecv4er= gsr23r*h4gr-ppr23*h4cr
        ecv4ei= gsr23r*h4gi-ppr23*h4ci
        ecv5er= gsr23r*h5gr-ppr23*h5cr
        ecv5ei= gsr23r*h5gi-ppr23*h5ci
        ecv6er= gsr23r*h6gr-ppr23*h6cr
        ecv6ei= gsr23r*h6gi-ppr23*h6ci
       endif
*
*-----computes cross-section
*
*-----born matrix element is calculated at the reduced c.m. energy
*
*-----propagators for pair production diagrams
*
                     pfp= e4-1.d0
                     pfb= e1-1.d0
                     pfpb= e3-1.d0
                     pf= e2-1.d0
*
*-----extra propagators
*
                     if(otype.eq.'cc20') then
                       pm23= t2+t3-su
                       pm24= t2+t4-x46
                      if(ofl.eq.'c') then
                       app14r= (x14+rswrv)/((x14+rswrv)**2+srwis/vvs)
                       app14i= -rswiv/((x14+rswrv)**2+srwis/vvs)
                       pp14rb= app14r*rhr14-app14i*rhi14
                       pp14r= gr14/g2*pp14rb
                       pp14i= gr14/g2*(app14r*rhi14+app14i*rhr14)
                       cob1e= gsr23r+0.25d0*x23*velr23/ctr23*
     #                        pp23r
                       cob1a= gsr23r+0.25d0*x23*vel23*vel23/
     #                        ctr23*pp23r
                       com1e= -gsr23r*chdp+0.25d0*x23*ver23*
     #                        vdpl23/ctr23*pp23r
                       com1a= -gsr23r*chdp+0.25d0*x23*vel23*
     #                        vdpl23/ctr23*pp23r
                       com2e= gsr23r*chup-0.25d0*x23*ver23*
     #                        vupl23/ctr23*pp23r
                       com2a= gsr23r*chup-0.25d0*x23*vel23*
     #                        vupl23/ctr23*pp23r
                       cofce= gsr23r-ppr23
                       cofad= gsr23r-ppl23
                      else
                       x23z= x23+rszm2
                       rx23= x23/x23z
                       pp14= x14+rwm2/vv
                       pp14f= x14+frwm2/vv
                       pp14d= pp14f*pp14f+rwmgs/vvs
                       pp14r= pp14f/pp14d
                       pp14i= rwmg/vv/pp14d
                       cob1e= sth2+0.25d0*velr/cth2*rx23
                       cob1a= sth2+0.25d0*vel*vel/cth2*rx23
                       com1e= -chdp*sth2+0.25d0*ver*vdpl/cth2*rx23
                       com1a= -chdp*sth2+0.25d0*vel*vdpl/cth2*rx23
                       com2e= chup*sth2-0.25d0*ver*vupl/cth2*rx23
                       com2a= chup*sth2-0.25d0*vel*vupl/cth2*rx23
                       cofce= sth2-0.5d0*ver*rx23
                       cofad= sth2-0.5d0*vel*rx23
                       cofcer= -0.25d0*ver/cth2*rx23
                       cofadr= -0.25d0*vel/cth2*rx23
                      endif
                     endif
*
*-----compensating single W propagators 
*
                     if(ofl.eq.'c') then
                        wpcfr= sp-rswrv
                        wmcfr= sm-rswrv
                        wpcfi= -rswiv
                        wmcfi= -rswiv
                        fov= 1.d0
                     else
                        fov= 1.d0
                        if(oww.eq.'r') then
                           wpcfr= sp-rwm2/vv
                           wmcfr= sm-rwm2/vv
                           wpcfi= sp*swg
                           wmcfi= sm*swg
                        else if(oww.eq.'f'.or.oww.eq.'i') then
                           wpcfr= sp-frwm2/vv
                           wmcfr= sm-frwm2/vv
                           wpcfi= rwmg/vv
                           wmcfi= rwmg/vv
                        endif
                     endif
*
*-----Compensating double W propagator
*
                     if(ofl.eq.'c') then
                        wtcfr= wpcfr*wmcfr-wmcfi*wpcfi
                     else
                      if(oww.eq.'r') then
                         wtcfr= wpcfr*wmcfr-sp*sm*swgs
                      else if(oww.eq.'f'.or.oww.eq.'i') then
                         wtcfr= wpcfr*wmcfr-rwmgs/vv/vv
                      endif
                     endif
                     wtcfi= wpcfr*wmcfi+wmcfr*wpcfi
*
*-----The epsilons are computed in the order9
*     epf(pp,pm,q1,q2),epf(pp,pm,q1,q3),epf(pp,pm,q1,q4)
*     epf(pp,pm,q2,q3),epf(pp,pm,q2,q4),epf(pp,pm,q3,q4)
*     epf(pp,q1,q2,q3),epf(pp,q1,q2,q4),epf(pp,q1,q3,q4)
*     epf(pp,q2,q3,q4),epf(pm,q1,q2,q3),epf(pm,q1,q2,q4)
*     epf(pm,q1,q3,q4),epf(pm,q2,q3,q4),epf(q1,q2,q3,q4)
*
                     x13s= x13*x13
                     x14s= x14*x14
                     x15s= x15*x15
                     x16s= x16*x16
                     x23s= x23*x23
                     x24s= x24*x24
                     x25s= x25*x25
                     x26s= x26*x26
                     x34s= x34*x34
                     x35s= x35*x35
                     x36s= x36*x36
                     x45s= x45*x45
                     x46s= x46*x46
                     x56s= x56*x56
                     if(ofl.ne.'n') then
                        x45i= 1.d0/x45
                        x56i= 1.d0/x56
                        p1= x13*x14
                        p2= x13*x16
                        p3= x13*x23
                        p4= x13*x25
                        p5= x13*x25s
                        p6= x13s*x25s
                        p7= x13*x26
                        p8= x13*x35
                        p9= x13*x45
                        p10= x13*x46
                        p11= x13*x56
                        p12= x14*x16
                        p13= x14*x23
                        p14= x14*x23s
                        p15= x14*x25
                        p16= x14*x25s
                        p17= x14*x26
                        p18= x14*x35
                        p19= x14*x35s
                        p20= x14*x36
                        p21= x14*x45
                        p22= x14*x56
                        p23= x15*x23
                        p24= x15*x24
                        p25= x15*x26
                        p26= x15*x34
                        p27= x15*x36
                        p28= x15*x46
                        p29= x16*x23
                        p30= x16*x23
                        p31= x16*x25
                        p32= x16*x25s
                        p33= x16*x34
                        p34= x16*x35
                        p35= x16*x56
                        p36= x23*x25
                        p37= x23*x26
                        p38= x23*x34
                        p39= x23*x35
                        p40= x23*x36
                        p41= x23*x45
                        p42= x23*x46
                        p43= x23*x56
                        p44= x23*x56s
                        p45= x24*x25
                        p46= x24*x35
                        p47= x24*x36
                        p48= x24*x56
                        p49= x25*x26
                        p50= x25*x34
                        p51= x25*x35
                        p52= x25*x36
                        p53= x25*x45
                        p54= x25*x46
                        p55= x25*x56
                        p56= x26*x34
                        p57= x26*x35
                        p58= x26*x35s
                        p59= x26s*x35
                        p60= x26*x36
                        p61= x26*x45
                        p62= x26s*x45
                        p63= x26*x56
                        p64= x34*x35
                        p65= x34*x36
                        p66= x34*x46
                        p67= x34*x56
                        p68= x34*x56s
                        p69= x35*x36
                        p70= x35*x45
                        p71= x35*x46
                        p72= x35*x56
                        p73= x36*x45
                        p74= x36*x46
                        p75= x45*x56
                        p76= x46*x56
                        p77= x15*x25
                        p78= x16*x24
                        p79= x16*x26
*
                        u1= p1*x25                                             
                        u2= p1*x56
                        u3= p3*x45
                        u4= x13*p48
                        u5= p4*x46
                        u6= p4*x56
                        u7= p7*x45
                        u8= x13*p73
                        u9= p12*x23
                        u10= p12*x25
                        u11= p12*x35
                        u12= p13*x35
                        u13= p13*x56
                        u14= p15*x26
                        u15= p15*x35
                        u16= p15*x36
                        u17= p15*x56
                        u18= p17*x35
                        u19= p18*x36
                        u20= p20*x45
                        u21= p23*x46
                        u22= p24*x36
                        u23= p25*x34
                        u24= p29*x45
                        u25= x16*p46
                        u26= p31*x34
                        u27= p31*x35
                        u28= p36*x46
                        u29= p49*x34
                        u30= p36*x36
                        u31= p36*x34
                        u32= p38*x56
                        u33= p50*x56
                        u34= p52*x45
                        u35= p54*x56
                        u36= p57*x45
                        u37= p57*x56
                        u38= p64*x56
                        u39= p37*x46
                        u40= p39*x56
                        u41= p52*x56
                        u42= p39*x45
                        u43= p9*x36
                        u44= p11*x24
                        u45= p34*x24
                     endif
*                                                                       
                     ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+
     #                      x14*x23*x34)-x13s*x24s-x14s*x23s-x34s
                     ee(2)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+
     #                      x15*x23*x35)-x13s*x25s-x15s*x23s-x35s
                     ee(3)= 2.d0*(x14*x15*x24*x25+x14*x25*x45+
     #                      x15*x24*x45)-x14s*x25s-x15s*x24s-x45s
                     ee(4)= 2.d0*(x13*x14*x35*x45+x13*x15*x34*x45+
     #                      x14*x15*x34*x35)-x13s*x45s-x14s*x35s-
     #                      x15s*x34s
                     ee(5)= 2.d0*(x23*x24*x35*x45+x23*x25*x34*x45+
     #                      x24*x25*x34*x35)-x23s*x45s-x24s*x35s-
     #                      x25s*x34s
*                                                                      
                     e(1)= 1.d0
                     e(2)= x13*x14*x23*x25+x13*x15*x23*x24+x13*(-2.d0*
     #                     x23*x45+x24*x35+x25*x34)-x14*x15*x23s+x14*
     #                     x23*x35+x15*x23*x34-x13s*x24*x25-x34*x35
                     e(3)= -x13*x14*x24*x25+x13*x15*x24s-x13*x24*x45-
     #                     x14*x15*x23*x24+x14*(-x23*x45+2.d0*x24*x35-
     #                     x25*x34)-x15*x24*x34+x14s*x23*x25+x34*x45
                     e(4)= x13*x14*(x23*x45+x24*x35-2.d0*x25*x34)+x13*
     #                     x15*x24*x34+x13*x34*x45+x14*x15*x23*x34+x14*
     #                     x34*x35-x15*x34s-x13s*x24*x45-x14s*x23*x35 
                     e(5)= x13*(-x23*x24*x45-x24*x25*x34+x35*x24s)+x14*
     #                     (-x23*x24*x35-x23*x25*x34+x45*x23s)+x15*
     #                     2.d0*x23*x24*x34-x23*x34*x45-x24*x34*x35+
     #                      x25*x34s
*
*
*-----sign of eps_1*eps_in
*
                     ises= 0
                     sg(1)= 0.25d0
                     if(ee(1).lt.0.d0) then 
                        ises= ises+1
                     endif
                     do i=2,5 
                         if(abs(e(i)).lt.zrm) then
                            ises= ises+1
                         else if(e(i).gt.zrm) then
                            sg(i)= 0.25d0 
                         else if(e(i).lt.-zrm) then
                            sg(i)= -0.25d0
                         endif
                         if(ee(i).lt.0.d0) then 
                            ises= ises+1
                         endif
                     enddo
*
                     if(ises.eq.0) then
                        ses1= sg(1)*sqrt(ee(1))
                        ses2= sg(2)*sqrt(ee(2))
                        ses3= sg(3)*sqrt(ee(3))
                        ses4= sg(4)*sqrt(ee(4))
                        ses5= sg(5)*sqrt(ee(5))
                        s1= ses1
                        s2= ses2
                        s3= -ses1-ses2
                        s4= ses3
                        s5= ses1-ses3
                        s6= ses2+ses3
                        s7= ses4
                        s8= ses1-ses4
                        s9= ses2+ses4
                        s10= ses3-ses4
                        s11= ses5
                        s12= -ses1-ses5
                        s13= -ses2+ses5
                        s14= -ses3-ses5
                        s15= -ses4-ses5
                     else
                        ee(1)= 2.d0*(x13*x14*x23*x24+x13*x24*x34+
     #                         x14*x23*x34)-x13s*x24s-x14s*x23s-x34s
                        ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+
     #                         x16*x23*x36)-x13s*x26s-x16s*x23s-x36s
                        ee(3)= 2.d0*(x14*x16*x24*x26+x14*x26*x46+
     #                         x16*x24*x46)-x14s*x26s-x16s*x24s-x46s
                        ee(4)= 2.d0*(x13*x14*x36*x46+x13*x16*x34*x46+
     #                         x14*x16*x34*x36)-x13s*x46s-x14s*x36s-
     #                         x16s*x34s
                        ee(5)= 2.d0*(x23*x24*x36*x46+x23*x26*x34*x46+
     #                          x24*x26*x34*x36)-x23s*x46s-x24s*x36s-
     #                          x26s*x34s
                        e(1)= 1.d0
                        e(2)= x13*x14*x23*x26+x13*x16*x23*x24+
     #                        x13*(-2.d0*x23*x46+x24*x36+x26*x34)-
     #                        x14*x16*x23s+x14*x23*x36+x16*x23*x34-
     #                        x13s*x24*x26-x34*x36
                        e(3)= -x13*x14*x24*x26+x13*x16*x24s-x13*
     #                        x24*x46-x14*x16*x23*x24+x14*(-x23*
     #                        x46+2.d0*x24*x36-x26*x34)-x16*x24*
     #                        x34+x14s*x23*x26+x34*x46
                        e(4)= x13*x14*(x23*x46+x24*x36-2.d0*x26*
     #                        x34)+x13*x16*x24*x34+x13*x34*x46+
     #                        x14*x16*x23*x34+x14*x34*x36-x16*
     #                        x34s-x13s*x24*x46-x14s*x23*x36 
                        e(5)= x13*(-x23*x24*x46-x24*x26*x34+x36*
     #                        x24s)+x14*(-x23*x24*x36-x23*x26*
     #                        x34+x46*x23s)+x16*2.d0*x23*x24*x34-
     #                        x23*x34*x46-x24*x34*x36+x26*x34s
                        ises= 0
                        sg(1)= 0.25d0
                        if(ee(1).lt.0.d0) then
                           ises= ises+1
                        endif
                        do i=2,5
                            if(abs(e(i)).lt.zrm) then
                               ises= ises+1
                            else if(e(i).gt.zrm) then
                               sg(i)= 0.25d0
                            else if(e(i).lt.-zrm) then
                               sg(i)= -0.25d0
                            endif
                            if(ee(i).lt.0.d0) then
                               ises= ises+1
                            endif
                        enddo
                        if(ises.eq.0) then
                           ses1= sg(1)*sqrt(ee(1))
                           ses2= sg(2)*sqrt(ee(2))
                           ses3= sg(3)*sqrt(ee(3))
                           ses4= sg(4)*sqrt(ee(4))
                           ses5= sg(5)*sqrt(ee(5))
                           s1= ses1
                           s2= -ses1-ses2
                           s3= ses2
                           s4= -ses1-ses3
                           s5= ses3
                           s6= -ses2-ses3
                           s7= ses1-ses4
                           s8= ses4
                           s9= -ses2-ses4
                           s10= -ses3+ses4
                           s11= -ses1-ses5
                           s12= ses5
                           s13= ses2-ses5
                           s14= ses3+ses5
                           s15= ses4+ses5
                        else
                           ee(1)= 2.d0*(x13*x15*x23*x25+x13*x25*x35+
     #                            x15*x23*x35)-x13s*x25s-x15s*x23s-
     #                            x35s
                           ee(2)= 2.d0*(x13*x16*x23*x26+x13*x26*x36+
     #                            x16*x23*x36)-x13s*x26s-x16s*x23s-
     #                            x36s
                           ee(3)= 2.d0*(x15*x16*x25*x26+x15*x26*x56+
     #                            x16*x25*x56)-x15s*x26s-x16s*x25s-
     #                            x56s
                           ee(4)= 2.d0*(x13*x15*x36*x56+x13*x16*x35*
     #                            x56+x15*x16*x35*x36)-x13s*x56s-
     #                            x15s*x36s-x16s*x35s
                           ee(5)= 2.d0*(x23*x25*x36*x56+x23*x26*x35*
     #                            x56+x25*x26*x35*x36)-x23s*x56s-
     #                            x25s*x36s-x26s*x35s
*                                                                      
                           e(1)= x13*x14*x23*x25+x13*x15*x23*x24+
     #                           x13*(-2.d0*x23*x45+x24*x35+x25*x34)-
     #                           x14*x15*x23s+x14*x23*x35+x15*x23*
     #                           x34-x13s*x24*x25-x34*x35
                           e(2)= x13*x14*x23*x26+x13*x16*x23*x24+
     #                           x13*(-2.d0*x23*x46+x24*x36+x26*x34)-
     #                           x14*x16*x23s+x14*x23*x36+x16*x23*
     #                           x34-x13s*x24*x26-x34*x36
                           e(3)= -x13*x15*x24*x26+x13*x16*x24*x25+
     #                           x13*(-x25*x46+x26*x45)+x14*x15*x23*
     #                           x26-x14*x16*x23*x25+x14*(x25*x36-x26*
     #                           x35)+x15*(-x23*x46+x24*x36)+x16*(x23*
     #                           x45-x24*x35)+x35*x46-x36*x45
                           e(4)= x13*x14*(x25*x36-x26*x35)+x13*x15*
     #                           (x23*x46-x26*x34)+x13*x16*(-x23*x45+
     #                           x25*x34)+x13*(x35*x46-x36*x45)-x14*
     #                           x15*x23*x36+x14*x16*x23*x35+x15*x34*
     #                           x36-x16*x34*x35+x13s*(-x25*x46+x26*
     #                           x45)
                           e(5)= x13*(-x23*x25*x46+x23*x26*x45+x24*x25*
     #                           x36-x24*x26*x35)+x15*(-x23*x24*x36-
     #                           x23*x26*x34+x46*x23s)+x16*(x23*x24*
     #                           x35+x23*x25*x34-x45*x23s)-x23*x35*
     #                           x46+x23*x36*x45-x25*x34*x36+x26*x34*
     #                           x35
*
                           ises= 0
                           do i=1,5
                               if(abs(e(i)).lt.zrm) then
                                  ises= ises+1
                               else if(e(i).gt.zrm) then
                                  sg(i)= 0.25d0
                               else if(e(i).lt.-zrm) then
                                  sg(i)= -0.25d0
                               endif
                               if(ee(i).lt.0.d0) then
                                  ises= ises+1
                               endif
                           enddo
                           if(ises.eq.0) then
                              ses1= sg(1)*sqrt(ee(1))
                              ses2= sg(2)*sqrt(ee(2))
                              ses3= sg(3)*sqrt(ee(3))
                              ses4= sg(4)*sqrt(ee(4))
                              ses5= sg(5)*sqrt(ee(5))
                              s1= -ses1-ses2
                              s2= ses1
                              s3= ses2
                              s4= -ses1+ses3
                              s5= -ses2-ses3
                              s6= ses3
                              s7= -ses1+ses4
                              s8= -ses2-ses4
                              s9= ses4
                              s10= ses3-ses4
                              s11= ses1+ses5
                              s12= ses2-ses5
                              s13= ses5
                              s14= -ses3-ses5
                              s15= -ses4-ses5
                           else
                              iz= 0
                              ifz(48)= ifz(48)+1
                              go to 4
                           endif
                        endif
                     endif
*
                     tgn(1)= x15*x24
                     tgn(2)= x34*x46
                     tgn(3)= x34/x46
                     tgn(4)= x24/x15
                     tgn(5)= x15/x25
                     tgn(6)= x15*x25
                     tgn(7)= x14*x34
                     tgn(8)= x25*x46
                     tgn(9)= x25/x46
                     tgn(10)= x14/x34
                     tgn(11)= x45/x36
                     tgn(12)= x14*x24
                     tgn(13)= x24/x14
                     tgn(14)= x45*x36
                     tgn(15)= x14/x25
* 
                     itgn= 0
                     do l=1,15
                         if(tgn(l).le.0.d0) then
                            itgn= itgn+1
                         endif
                     enddo
                     if(itgn.ne.0) then
                        iz= 0
                        ifz(49)= ifz(49)+1
                        go to 4
                     endif
                     gpna= sqrt(x15*x24)
                     gpnb= sqrt(x34*x46)
                     gpnc= sqrt(x34/x46)
                     gpnd= sqrt(x24/x15)
                     gpne= sqrt(x15/x25)
                     gpnf= sqrt(x15*x25)
                     gmna= sqrt(x14*x34)
                     gmnb= sqrt(x25*x46)
                     gmnc= sqrt(x25/x46)
                     gmnd= sqrt(x14/x34)
                     gmne= sqrt(x45/x36)
                     gmnf= sqrt(x14*x24)
                     gmng= sqrt(x24/x14)
                     gmnh= sqrt(x45*x36)
                     gmni= sqrt(x14/x25)
*
                     gn1= gpna/gpnb
                     gn2= gpna*gpnc
                     gn3= gpna/gpnc
                     gn4= gpnd/gpnb
                     gn5= 1.d0/gpna/gpnc
                     gn6= 1.d0/gpnd/gpnc
                     gn7= gpnd/gpnc
                     gn8= gpnb/gpna
                     gn9= gpnd*gpnc
                     gn10= gpnb/gpnd
                     gn11= gpna*gpnb
                     gn12= gmnd/gmnb
                     gn13= 1.d0/gmnc/gmna 
                     gn14= gmna/gmnb
                     gn15= gmnd/gmnc
                     gn16= 1.d0/gmnd/gmnc 
                     gn17= gmna*gmnb
                     gn18= gmnc/gmnd
                     gn19= gmnc/gmna
                     gn20= gmna*gmnc
                     gn21= gmnd*gmnb
                     gn22= gmnd*gmnc
                     gn23= gmnb/gmnd
                     gn24= gmnb/gmna
                     gn25= gpnc/gpnd
                     gn26= 1.d0/gpna/gpnb 
                     gn27= gpnc/gpna
                     gn28= 1.d0/gpnd/gpnb 
                     gn29= gpne/gmnh
                     gn30= gmne/gpnf
                     gn31= 1.d0/gpnf/gmne 
                     gn32= 1.d0/gpnf/gmnh 
                     gn33= gpne*gmne
                     gn34= gpne/gmne
                     gn35= gmnh/gpnf
                     gn36= gmnh*gpne
                     gn37= gpnb*gmni
* 
*-----helicity a) 
* 
*-----conversion diagram without t-channel propagator
*                                                                       
                      if(ofl.eq.'c'.or.ofl.eq.'a') then
                         flpr= grp*rhrp-gip*rhip
                         flpi= grp*rhip+gip*rhrp
                         flmr= grm*rhrm-gim*rhim
                         flmi= grm*rhim+gim*rhrm
                         flr= flpr*flmr-flpi*flmi
                         fli= flpr*flmi+flpi*flmr 
                         adcr= 2.d0*(gn1*x36*(x45-x14)+
     #                         gn2*(x16-x56)+gn3*(x13-x35)) 
                         adcie= 8.d0*gn1*(s8-s15)
                         g4= g2*g2
                         dcr= adcr*flr/g4
                         dci= adcr*fli/g4 
                         dcie= adcie*flr/g4 
                         dcre= -adcie*fli/g4
                      else
                         g4= g2*g2
                         dcr= 2.d0*(gn1*x36*(x45-x14)+
     #                        gn2*(x16-x56)+gn3*(x13-x35))
                         dcie= 8.d0*gn1*(s8-s15)
                         dci= 0.d0
                         dcre= 0.d0 
                      endif 
*
*-----annihilation diagrams: common part                                
* 
                      daarc= 2.d0*gn1*x36*x45-2.d0*gn2*x56+
     #                       gn3*(-x35+1.5d0*x36)+2.d0*gn4*
     #                       (x13*x36*x45-x14*x35*x36)+gn5*
     #                       (-x13*x23*x45-0.5d0*x13*x25*x46+
     #                       0.5d0*x13*x26*x45+x14*x23*x35-
     #                       0.5d0*x14*x23*x56+0.5d0*x14*x25*
     #                       x36-0.5d0*x14*x26*x35+0.5d0*x16*
     #                       x23*x45+0.5d0*x35*x46-0.5d0*x36*
     #                       x45)+gn6*(-x23*x45-1.5d0*x23*
     #                       x46)+gn7*(x13*x45+0.5d0*x13*x56-
     #                       x14*x35-0.5d0*x16*x35)+gn8*(x13*
     #                       x25-0.5d0*x16*x25-x35+0.5d0*x56)+
     #                       2.d0*gn9*(-x13*x56+x16*x35)+
     #                       gn10*(x25+1.5d0*x26)+3.d0*gn11
                      daaic= -8.d0*gn1*s15+8.d0*gn4*s7*x36+
     #                       2.d0*gn5*(s2*x46-s5*x35-2.d0*s7*
     #                       x23+s7*x26+s14*x13)-2.d0*gn6*(2.d0*
     #                       s11+3.d0*s12)+2.d0*gn7*(2.d0*s7-s9)-
     #                       4.d0*gn8*s2+8.d0*gn9*s9
*-----The Fermion loop scheme starts here
*
      if(ofl.eq.'c'.or.ofl.eq.'a') then 
* 
      tgv(1)= x15*x24/x34/x46
      tgv(2)= x15*x24*x34/x46
      tgv(3)= x15*x24*x46/x34
      tgv(4)= x24/x15/x46/x34
      tgv(5)= x46/x15/x24/x34
      tgv(6)= x15*x46/x24/x34
      tgv(7)= x24*x46/x15/x34
      tgv(8)= 1.d0/x15/x24*x34*x46
      tgv(9)= 1.d0/x15*x24*x34/x46
      tgv(10)= x15/x24*x34*x46
      tgv(11)= x15/x24*x34/x46
      tgv(12)= x15*x24*x34*x46
      tgv(13)= 1.d0/x15/x24/x34/x46
      tgv(14)= 1.d0/x15/x24*x34/x46
      tgv(15)= 1.d0/x14/x25*x34/x46
      tgv(16)= x14/x25/x34/x46
      tgv(17)= x46/x14/x25/x34
      tgv(18)= x14*x34/x25/x46
      tgv(19)= x14*x46/x25/x34
      tgv(20)= x34*x46/x14/x25
      tgv(21)= x14*x34*x46*x25
      tgv(22)= x34*x25/x14/x46
      tgv(23)= x25/x14/x34/x46
      tgv(24)= x14*x34*x25/x46
      tgv(25)= x14*x25*x46/x34
      tgv(26)= x14*x25/x34/x46
      tgv(27)= x25*x34*x46/x14
      tgv(28)= x25*x46/x34/x14
      tgv(29)= 1.d0/x14/x24/x36*x45
      tgv(30)= 1.d0/x14*x24/x36*x45
      tgv(31)= 1.d0/x14/x24/x36/x45
      tgv(32)= 1.d0/x14*x24/x36/x45
      tgv(33)= x14/x24/x36*x45
      tgv(34)= x14/x24/x36/x45
      tgv(35)= x14*x24/x36/x45
      tgv(36)= x15/x24/x34/x46
      tgv(37)= x14*x24/x36*x45
      tgv(38)= x15/x25/x36/x45
      tgv(39)= 1.d0/x15/x25/x36*x45
      tgv(40)= 1.d0/x15/x25*x36/x45
      tgv(41)= 1.d0/x15/x25/x36/x45
      tgv(42)= x15/x25/x36*x45
      tgv(43)= x15/x25*x36/x45
      tgv(44)= 1.d0/x15/x25*x36*x45
      tgv(45)= x15/x25*x36*x45
      tgv(46)= x14/x25*x34*x46
      tgv(47)= 1.d0/x15*x24*x34*x46
      tgv(48)= 1.d0/x14/x25/x34/x46
*
      itgv= 0 
      do l=1,48 
          if(tgv(l).le.0.d0) then 
             itgv= itgv+1
          endif 
      enddo
      if(itgv.ne.0) then
         iz= 0
         ifz(49)= ifz(49)+1 
         go to 4
      endif 
*
      gv1= sqrt(tgv(1))       
      gv2= sqrt(tgv(2))      
      gv3= sqrt(tgv(3))       
      gv4= sqrt(tgv(4))       
      gv5= sqrt(tgv(5))       
      gv6= sqrt(tgv(6))       
      gv7= sqrt(tgv(7))      
      gv8= sqrt(tgv(8))      
      gv9= sqrt(tgv(9))      
      gv10= sqrt(tgv(10))       
      gv11= sqrt(tgv(11))       
      gv12= sqrt(tgv(12))       
      gv13= sqrt(tgv(13))       
      gv14= sqrt(tgv(14))       
      gv15= sqrt(tgv(15))      
      gv16= sqrt(tgv(16))       
      gv17= sqrt(tgv(17))      
      gv18= sqrt(tgv(18))       
      gv19= sqrt(tgv(19))       
      gv20= sqrt(tgv(20))       
      gv21= sqrt(tgv(21))      
      gv22= sqrt(tgv(22))       
      gv23= sqrt(tgv(23))      
      gv24= sqrt(tgv(24))      
      gv25= sqrt(tgv(25))      
      gv26= sqrt(tgv(26))       
      gv27= sqrt(tgv(27))      
      gv28= sqrt(tgv(28))       
      gv29= sqrt(tgv(29))      
      gv30= sqrt(tgv(30))       
      gv31= sqrt(tgv(31))      
      gv32= sqrt(tgv(32))       
      gv33= sqrt(tgv(33))      
      gv34= sqrt(tgv(34))      
      gv35= sqrt(tgv(35))      
      gv36= sqrt(tgv(36))      
      gv37= sqrt(tgv(37))       
      gv38= sqrt(tgv(38))      
      gv39= sqrt(tgv(39))       
      gv40= sqrt(tgv(40))       
      gv41= sqrt(tgv(41))      
      gv42= sqrt(tgv(42))       
      gv43= sqrt(tgv(43))      
      gv44= sqrt(tgv(44))       
      gv45= sqrt(tgv(45))       
      gv46= sqrt(tgv(46))      
      gv47= sqrt(tgv(47))      
      gv48= sqrt(tgv(48))       
* 
      if(ofl.eq.'c'.or.ofl.eq.'a') then
       tar4= gv1*x45i*(p20*p22+2*p20*p48+p47*p48)
       tar4= tar4+gv1*(-p12*x36-4*p17*x36-p20*x15
     #   -2*p45*x36-p47*x16-2*p47*x26+p73
     #   +u2-u7-u11-u13-3*u16+u18-u22+u24+u44-u45)
       tar4= tar4+gv2*x45i*(-2*p12*x56-2*p35*
     #   x24-p48*x26)
       tar4= tar4+gv2*(2*x15*x16+2*x16s+2*x26s-
     #   x56+p25+3*p31+2*p49+3*p79)
       tar4= tar4+gv3*x45i*(-p20*x15-p43*x24-
     #   p45*x36+2*p46*x26-p71+u2-u5+u11
     #   -3*u13+3*u18+u21-u22+u28+u44+u45)
       tar4= tar4+gv3*(-x35+x36+p4+p7+p23+2*p36)
       tar4= tar4+gv4*x45i*(p12*p18*x56+2*p12*
     #   p46*x56-2*p17*p18*x56-p17*p46*x56-u2*
     #   p22-2*u2*p48+2*u13*p22+u13*p48-2
     #   *u17*p20-u17*p47-u44*p48+u45*p48)
       tar4= tar4+gv4*(p1*p35+2*p1*p63+
     #   p2*p48-p2*p61+p7*p48-p12*p34-
     #   3*p12*p43+p12*p52+p12*p57+2*p20*
     #   x56-p29*p48-p34*p78+p47*x56-p73*x16
     #   +u24*x16)
       tar4= tar4+gv5*x45i*(p15*p71+p16*p20
     #   +p18*p22-u1*p54+u2*p15-2*u11*p15-u13*p15-u15*p17)
       tar4= tar4+gv5*(p1*p31+p1*p49+p12*p36
     #   -2*u2+u11-u16)
       tar4= tar4+gv6*x45i*(-p1*p54-2*p13*
     #   p22+p13*p28+p13*p54+p15*p20+p17*p18-p18*x46)
       tar4= tar4+gv6*(p1*x26+p13*x15+2*p13*
     #   x25-p18+p20+u1)
       tar4= tar4+gv7*x45i*(3*p1*p55+2*p4*p48
     #   -p5*x46-3*p12*p51-p13*p55-p15*
     #   p57+p16*x36-p31*p46-p46*x56+p51*x46)
       tar4= tar4+gv7*(p2*x25+p4*x26-2*p11
     #   +p29*x25+p34-p52)
       tar4= tar4+gv8*x45i*(u10*x25-u17)
       tar4= tar4+gv8*(2*x56-2*p31)
       tar4= tar4+gv9*x45i*(2*p15*p63-p31*p48
     #   +p48*x56)
       tar4= tar4+gv9*(p31*x16-p35-2*p63)
       tar4= tar4+gv10*x45i*(-p17*x15+p22+u10-u14)
       tar4= tar4+gv10*(-2*x16-2*x25-2*x26)
       tar4= tar4+gv11*x45i*(p17*p22)
       tar4= tar4+gv11*(-2*x16*x45+p12*x26-p17
     #   *x15+2*p17*x26+p22+u10)
       tar4= tar4+gv12*x45i*(x56-p25+p31-p49)
       tar4= tar4+gv13*x45i*(p13*p22*p22-p15
     #   *p20*p22-p17*p18*p22)
       tar4= tar4+gv13*(-p1*p61*x16-p12*p73
     #   -2*p12*u13+p12*u16+p12*u24+p20
     #   *p22+u2*p17+u11*p17)
       tar4= tar4+gv14*x45i*(p12*u17-p22*p22
     #   +2*u17*p17)
       tar4= tar4+gv14*(p12*x56-p12*p31-2*
     #   p12*p49-2*p17*x56+2*p61*x16)
       tar4= tar4+gv36*(-p1*p61+p12*p41
     #   -p13*p22-p15*p20+p17*p18-2*p17*p20+u20)
       tar4= tar4+gv47*x45i*(p32-p55)
* 
       tar2= gv1*(-4*p73)
       tar2= tar2+gv2*(4*x56)
       tar2= tar2+gv3*(-4*x36)
       tar2= tar2+gv4*(-4*u19+4*u43)
       tar2= tar2+gv6*(4*p41+4*p42)
       tar2= tar2+gv7*(4*p9-4*p18)
       tar2= tar2+gv9*(-4*p11+4*p34)
       tar2= tar2+gv10*(-4*x25-4*x26)
       tar2= tar2+gv12*(4)
*
       tar3= gv1*(4*p73)
       tar3= tar3+gv2*(-4*x56)
       tar3= tar3+gv3*(4*x36)
       tar3= tar3+gv4*(-4*u19+4*u43)
       tar3= tar3+gv6*(-4*p41-4*p42)
       tar3= tar3+gv7*(4*p9-4*p18)
       tar3= tar3+gv9*(-4*p11+4*p34)
       tar3= tar3+gv10*(4*x25+4*x26)
       tar3= tar3+gv12*(4)
*
       tar5= gv1*(2*p73)
       tar5= tar5+gv2*(-2*x56)
       tar5= tar5+gv3*(-2*x35-x36)
       tar5= tar5+gv4*(2*u19-2*u43)
       tar5= tar5+gv5*(-p71+p73+u5-u7
     #  +u13-u16+u18-u24)
       tar5= tar5+gv5*(2*u3-2*u12)
       tar5= tar5+gv6*(p42)
       tar5= tar5+gv7*(-p11+p34)
       tar5= tar5+gv8*(-x56+p31)
       tar5= tar5+gv8*(2*x35-2*p4)
       tar5= tar5+gv9*(2*p11-2*p34)
       tar5= tar5+gv10*(-x26)
       tar5= tar5+gv12*(4)
*
       tar6= gv1*(2*p73)
       tar6= tar6+gv2*(-2*x56)
       tar6= tar6+gv3*(-2*x35-x36)
       tar6= tar6+gv4*(-2*u19+2*u43)
       tar6= tar6+gv5*(-p71+p73+u5-u7
     #  +u13-u16+u18-u24)
       tar6= tar6+gv5*(-2*u3+2*u12)
       tar6= tar6+gv6*(p42)
       tar6= tar6+gv7*(-p11+p34)
       tar6= tar6+gv8*(-x56+p31)
       tar6= tar6+gv8*(-2*x35+2*p4)
       tar6= tar6+gv9*(-2*p11+2*p34)
       tar6= tar6+gv10*(-x26)
       tar6= tar6+gv12*(-4)
*
       tai4= s1*gv4*(-4*p35)
       tai4= tai4+s1*gv5*x45i*(4*u17)
       tai4= tai4+s1*gv6*x45i*(-4*p22)
       tai4= tai4+s2*gv3*(4)
       tai4= tai4+s2*gv5*x45i*(-4*p22*x14)
       tai4= tai4+s2*gv5*(4*p12)
       tai4= tai4+s2*gv6*(4*x14)
       tai4= tai4+s2*gv7*x45i*(-4*p22)
       tai4= tai4+s3*gv3*(4)
       tai4= tai4+s3*gv4*(-4*p22-4*p48)
       tai4= tai4+s3*gv7*(4*x25)
       tai4= tai4+s4*gv4*x45i*(4*p47*x56)
       tai4= tai4+s4*gv4*(-4*x16*x36)
       tai4= tai4+s4*gv7*x45i*(8*p34-4*p52)
       tai4= tai4+s4*gv8*x45i*(-8*p31)
       tai4= tai4+s4*gv10*x45i*(8*x16+8*x26)
       tai4= tai4+s4*gv11*(8*x16)
       tai4= tai4+s4*gv14*x45i*(-8*p17*x56)
       tai4= tai4+s4*gv36*(-4*p20)
       tai4= tai4+s5*gv1*(-4*x35)
       tai4= tai4+s5*gv2*x45i*(-8*x56)
       tai4= tai4+s5*gv3*x45i*(-4*x35)
       tai4= tai4+s5*gv4*x45i*(8*p18*x56)
       tai4= tai4+s5*gv4*(-4*p34)
       tai4= tai4+s5*gv10*x45i*(8*x25)
       tai4= tai4+s5*gv11*(8*x25-8*x26)
       tai4= tai4+s5*gv13*x45i*(4*p18*p22)
       tai4= tai4+s5*gv13*(-4*u11)
       tai4= tai4+s5*gv14*(8*x56+8*p31)
       tai4= tai4+s6*gv5*x45i*(-8*p18*x14)
       tai4= tai4+s6*gv5*(8*p1)
       tai4= tai4+s6*gv8*x45i*(-4*p15)
       tai4= tai4+s6*gv9*x45i*(-4*p22)
       tai4= tai4+s6*gv9*(8*x26)
       tai4= tai4+s6*gv10*x45i*(-4*x14)
       tai4= tai4+s6*gv11*(4*x14)
       tai4= tai4+s6*gv12*x45i*(4)
       tai4= tai4+s7*gv3*x45i*(-4*x26)
       tai4= tai4+s7*gv4*x45i*(8*p17*x56+4*p48*x26)
       tai4= tai4+s7*gv6*x45i*(4*p17)
       tai4= tai4+s7*gv7*x45i*(4*p49)
       tai4= tai4+s7*gv13*x45i*(4*p17*p22)
       tai4= tai4+s7*gv13*(-4*p12*x26)
       tai4= tai4+s8*gv1*(4*x25+8*x26)
       tai4= tai4+s8*gv4*(-8*x56)
       tai4= tai4+s8*gv6*x45i*(4*p15)
       tai4= tai4+s8*gv36*(4*p15)
       tai4= tai4+s9*gv4*x45i*(4*p22*x14+4*p22*x24)
       tai4= tai4+s9*gv4*(-4*p12-4*p78)
       tai4= tai4+s9*gv7*x45i*(-4*p15)
       tai4= tai4+s10*gv1*(-4*x23)
       tai4= tai4+s10*gv2*x45i*(-8*x16-8*x26)
       tai4= tai4+s10*gv4*x45i*(-4*p43*x24)
       tai4= tai4+s10*gv5*x45i*(4*p13*x25)
       tai4= tai4+s10*gv7*x45i*(4*p36)
       tai4= tai4+s10*gv9*x45i*(-8*p49)
       tai4= tai4+s11*gv1*(4*x16)
       tai4= tai4+s11*gv3*x45i*(4*x16+8*x25)
       tai4= tai4+s11*gv4*x45i*(-4*p12*x56)
       tai4= tai4+s11*gv5*x45i*(4*u10)
       tai4= tai4+s12*gv1*x45i*(-4*p22-4*p48)
       tai4= tai4+s12*gv3*x45i*(4*x25)
       tai4= tai4+s12*gv6*x45i*(4*p15)
       tai4= tai4+s12*gv36*x45i*(-4*p22*x14)
       tai4= tai4+s12*gv36*(4*x14*x15+4*p12+8*p15)
       tai4= tai4+s13*gv1*(4*x14)
       tai4= tai4+s13*gv4*x45i*(4*p22*x24)
       tai4= tai4+s13*gv4*(4*p12)
       tai4= tai4+s13*gv6*x45i*(-4*x14s)
       tai4= tai4+s13*gv7*x45i*(-4*p15)
       tai4= tai4+s14*gv2*x45i*(-8*x25)
       tai4= tai4+s14*gv4*x45i*(-4*u2)
       tai4= tai4+s14*gv6*x45i*(4*p1)
       tai4= tai4+s14*gv10*x45i*(8)
       tai4= tai4+s14*gv13*x45i*(-4*p1*p22)
       tai4= tai4+s14*gv13*(4*p1*x16)
       tai4= tai4+s14*gv14*x45i*(-8*p22)
       tai4= tai4+s14*gv14*(-8*x16)
       tai4= tai4+s15*gv1*x45i*(8*x24*x26+8*p17+8*p45)
       tai4= tai4+s15*gv3*x45i*(-4)
       tai4= tai4+s15*gv4*x45i*(4*p22)
       tai4= tai4+s15*gv4*(4*x16)
       tai4= tai4+s15*gv36*x45i*(8*p17*x14)
       tai4= tai4+s15*gv36*(-4*x14)
*
       tai2= s7*gv4*(16*x36)
       tai2= tai2+s7*gv7*(16)
       tai2= tai2+s9*gv9*(16)
       tai2= tai2+s11*gv6*(16)
       tai2= tai2+s12*gv6*(16)
       tai2= tai2+s15*gv1*(16)
*
       tai3= s7*gv4*(16*x36)
       tai3= tai3+s7*gv7*(16)
       tai3= tai3+s9*gv9*(16)
       tai3= tai3+s11*gv6*(-16)
       tai3= tai3+s12*gv6*(-16)
       tai3= tai3+s15*gv1*(-16)
*
       tai5= s1*gv14*(-4*x56)
       tai5= tai5+s2*gv8*(-4)
       tai5= tai5+s3*gv14*(4*x45)
       tai5= tai5+s4*gv8*(-4)
       tai5= tai5+s4*gv14*(-4*x56)
       tai5= tai5+s5*gv14*(-4*x56)
       tai5= tai5+s5*gv14*(4*x45)
       tai5= tai5+s6*gv8*(-4)
       tai5= tai5+s6*gv14*(-4*x45)
       tai5= tai5+s7*gv4*(4*x56)
       tai5= tai5+s7*gv4*(-4*x36)
       tai5= tai5+s7*gv5*(4*x25)
       tai5= tai5+s7*gv7*x45i*(4*x35)
       tai5= tai5+s7*gv8*x45i*(-8*x25)
       tai5= tai5+s7*gv9*x45i*(4*x56)
       tai5= tai5+s7*gv13*(-4*p61)
       tai5= tai5+s7*gv14*(4*x26)
       tai5= tai5+s8*gv4*(4*x56)
       tai5= tai5+s8*gv4*(-4*x35)
       tai5= tai5+s8*gv5*(4*x25)
       tai5= tai5+s8*gv13*(-4*p61)
       tai5= tai5+s8*gv13*(4*p41)
       tai5= tai5+s9*gv9*(4)
       tai5= tai5+s10*gv4*(-4*x35+4*x36)
       tai5= tai5+s10*gv7*x45i*(-4*x35)
       tai5= tai5+s10*gv8*x45i*(8*x25)
       tai5= tai5+s10*gv9*x45i*(-4*x56)
       tai5= tai5+s10*gv9*(4)
       tai5= tai5+s10*gv13*(4*p41)
       tai5= tai5+s10*gv14*(-4*x26)
       tai5= tai5+s11*gv5*x45i*(-4*p18)
       tai5= tai5+s11*gv5*(4*x13)
       tai5= tai5+s11*gv10*x45i*(8)
       tai5= tai5+s11*gv14*x45i*(-4*p22)
       tai5= tai5+s12*gv11*(-4)
       tai5= tai5+s13*gv14*(-4*x14)
       tai5= tai5+s14*gv5*x45i*(4*p18)
       tai5= tai5+s14*gv5*(-4*x13)
       tai5= tai5+s14*gv10*x45i*(-8)
       tai5= tai5+s14*gv11*(-4)
       tai5= tai5+s14*gv14*x45i*(4*p22)
       tai5= tai5+s14*gv14*(-4*x14)
       tai5= tai5+s15*gv1*(-4)
       tai5= tai5+s15*gv2*x45i*(4)
       tai5= tai5+s15*gv3*x45i*(4)
       tai5= tai5+s15*gv4*(-4*x16)
       tai5= tai5+s15*gv4*(4*x13)
       tai5= tai5+s15*gv5*x45i*(-4*p15)
       tai5= tai5+s15*gv13*(-4*x45+4*p15+4*p17)
       tai5= tai5+s15*gv13*(-4*p13)
       tai5= tai5+s15*gv14*x45i*(-4*p15)
       tai5= tai5+s15*gv14*(4)
*
       tai6= s1*gv14*(4*x56)
       tai6= tai6+s2*gv8*(4)
       tai6= tai6+s3*gv14*(-4*x45)
       tai6= tai6+s4*gv8*(4)
       tai6= tai6+s4*gv14*(-4*x56)
       tai6= tai6+s5*gv14*(-4*x56)
       tai6= tai6+s5*gv14*(-4*x45)
       tai6= tai6+s6*gv8*(-4)
       tai6= tai6+s6*gv14*(-4*x45)
       tai6= tai6+s7*gv4*(4*x56)
       tai6= tai6+s7*gv4*(4*x36)
       tai6= tai6+s7*gv5*(4*x25)
       tai6= tai6+s7*gv7*x45i*(-4*x35)
       tai6= tai6+s7*gv8*x45i*(8*x25)
       tai6= tai6+s7*gv9*x45i*(-4*x56)
       tai6= tai6+s7*gv13*(-4*p61)
       tai6= tai6+s7*gv14*(-4*x26)
       tai6= tai6+s8*gv4*(4*x56)
       tai6= tai6+s8*gv4*(4*x35)
       tai6= tai6+s8*gv5*(4*x25)
       tai6= tai6+s8*gv13*(-4*p61)
       tai6= tai6+s8*gv13*(-4*p41)
       tai6= tai6+s9*gv9*(-4)
       tai6= tai6+s10*gv4*(-4*x35+4*x36)
       tai6= tai6+s10*gv7*x45i*(-4*x35)
       tai6= tai6+s10*gv8*x45i*(8*x25)
       tai6= tai6+s10*gv9*x45i*(-4*x56)
       tai6= tai6+s10*gv9*(-4)
       tai6= tai6+s10*gv13*(4*p41)
       tai6= tai6+s10*gv14*(-4*x26)
       tai6= tai6+s11*gv5*x45i*(4*p18)
       tai6= tai6+s11*gv5*(-4*x13)
       tai6= tai6+s11*gv10*x45i*(-8)
       tai6= tai6+s11*gv14*x45i*(4*p22)
       tai6= tai6+s12*gv11*(4)
       tai6= tai6+s13*gv14*(4*x14)
       tai6= tai6+s14*gv5*x45i*(4*p18)
       tai6= tai6+s14*gv5*(-4*x13)
       tai6= tai6+s14*gv10*x45i*(-8)
       tai6= tai6+s14*gv11*(-4)
       tai6= tai6+s14*gv14*x45i*(4*p22)
       tai6= tai6+s14*gv14*(4*x14)
       tai6= tai6+s15*gv1*(-4)
       tai6= tai6+s15*gv2*x45i*(-4)
       tai6= tai6+s15*gv3*x45i*(4)
       tai6= tai6+s15*gv4*(-4*x16)
       tai6= tai6+s15*gv4*(-4*x13)
       tai6= tai6+s15*gv5*x45i*(-4*p15)
       tai6= tai6+s15*gv13*(-4*x45+4*p15+4*p17)
       tai6= tai6+s15*gv13*(4*p13)
       tai6= tai6+s15*gv14*x45i*(4*p15)
       tai6= tai6+s15*gv14*(-4)
* 
       if(ofl.eq.'c') then
        adaavr= -(cv2ar*tar2+cv3ar*tar3+cv4ar*tar4+
     #          cv5ar*tar5+cv6ar*tar6)/256.d0/pis
        adaavie= -(cv2ar*tai2+cv3ar*tai3+cv4ar*tai4+
     #          cv5ar*tai5+cv6ar*tai6)/256.d0/pis
        adaavi= -(cv2ai*tar2+cv3ai*tar3+cv4ai*tar4+
     #          cv5ai*tar5+cv6ai*tar6)/256.d0/pis
        adaavre= (cv2ai*tai2+cv3ai*tai3+cv4ai*tai4+
     #           cv5ai*tai5+cv6ai*tai6)/256.d0/pis
       else if(ofl.eq.'a') then
        adaavr= 0.5d0*(cv2ar*tar2+cv3ar*tar3+cv4ar*tar4+
     #          cv5ar*tar5+cv6ar*tar6)
        adaavie= 0.5d0*(cv2ar*tai2+cv3ar*tai3+cv4ar*tai4+
     #          cv5ar*tai5+cv6ar*tai6)
        adaavi= 0.5d0*(cv2ai*tar2+cv3ai*tar3+cv4ai*tar4+
     #          cv5ai*tar5+cv6ai*tar6)
        adaavre= -0.5d0*(cv2ai*tai2+cv3ai*tai3+cv4ai*tai4+
     #           cv5ai*tai5+cv6ai*tai6)
       endif
*
      endif
      endif 
*
                      if(otype.eq.'cc03') then
                         dpp1arc= 0.d0
                         dpp1aic= 0.d0
                         dpp2arc= 0.d0
                         dpp2aic= 0.d0
                         dpp3arc= 0.d0
                         dpp3aic= 0.d0
                         dpp4arc= 0.d0
                         dpp4aic= 0.d0
*
                      else if(otype.eq.'cc11'.or.otype.eq.
     #                        'cc12'.or.otype.eq.'cc20') then
*
*-----pair production I: common part                                   
* 
                       dpp1arc= -gn1*x24*x36+gn2*x26+gn3*(x23+x36)+
     #                          gn4*(x13*(x24*x56-x26*x45)-x14*(x23*
     #                          x56-x25*x36-x26*x35)+x16*(x23*x45-x24*
     #                          x35)-x36*x45)+gn5*(x13*(x25*x46-x26*
     #                          x45)+x14*(x23*x56-x25*x36+x26*x35)-x16*
     #                          x23*x45-x35*x46+x36*x45)-gn6*x23*x46+
     #                          gn7*(-x13*x25-x13*x56+x16*x35+x35)+
     #                          gn8*(x16*x25-x56)+gn9*(-x16*x25+x56)+
     #                          gn10*x26
                       dpp1aic= 4.d0*gn1*s12+4.d0*gn4*(-x25*s8-x36*
     #                          s4+s15)+4.d0*gn5*(x25*s8-2.d0*x26*s7+
     #                          x36*s4-x46*s2-s15)-4.d0*gn6*s12+4.d0*
     #                          gn7*s2+4.d0*gn8*s6-4.d0*gn9*s6
*
*
*-----pair production II: common part                                   
* 
                       dpp2arc= +2.d0*gn3*x13+2.d0*gn5*x23*(-x13*
     #                          x45+x14*x35)-2.d0*gn6*x14*x23+2.d0*
     #                          gn8*(x13*x25-x35)+2.d0*gn10
                       dpp2aic= 8.d0*(-gn5*x23*s7+gn6*s1-gn8*s2)
*
*-----pair production III: common part                               
*
                       dpp3arc= 2.d0*gn3*(x35-x13)+2.d0*gn6*(x14*
     #                          x23-x23*x45)+2.d0*gn10*(-1.d0+x25)
                       dpp3aic= -8.d0*gn6*(s1+s11)
*
*-----pair production IV: common part                               
*
                       dpp4arc= gn1*x24*x36-gn2*x26-gn3*x23+
     #                          gn4*(x13*(-x24*x56+x26*x45)+ 
     #                          x14*(x23*x56-x25*x36-x26*x35)-
     #                          x16*(x23*x45-x24*x35)+x36*x45)+
     #                          gn7*(x13*x25-2.d0*x13*x45+2.d0*
     #                          x14*x35-x35)+gn9*(x16*x25-x56)+
     #                          2.d0*gn11
                       dpp4aic= -4.d0*gn1*s12+4.d0*gn4*(x25*s8+x36*
     #                          s4-s15)-4.d0*gn7*(s2+2.d0*s7)+4.d0*
     #                          gn9*s6
*
                      endif
                      if(otype.eq.'cc03'.or.otype.eq.'cc11'.
     #                   or.otype.eq.'cc12') then
                         db1arc= 0.d0
                         db2arc= 0.d0
                         db3arc= 0.d0
                         db1aic= 0.d0
                         db2aic= 0.d0
                         db3aic= 0.d0
                         dm1arc= 0.d0
                         dm1aic= 0.d0
                         dm2arc= 0.d0
                         dm2aic= 0.d0
                         dfarc= 0.d0
                         dfaic= 0.d0

                      else if(otype.eq.'cc20') then
                       if(ofl.eq.'y') then
                        pgs= x23
                        pws= x14
                        pks= -x56
                        pgw= -0.5d0*(x56+x14+x23)
                        gil= (x56+x14)*(x56+x14)+2.d0*
     #                       (x56-x14)*x23+x23*x23
                        gil= 0.25d0*gil
                        sgil= sqrt(gil)
                        gils= gil*gil
                        cps= -x56+x23-x14
                        ri0= 0.5d0
                        rl0= (pgw-sgil)/(pgw+sgil)
                        rl0= 0.25d0/sgil*log(rl0)
*
                        gix= pgs
                        giy= pks
                        giz= cps
                        gixz= gix*giz
                        gixx= gix*gix
                        giyy= giy*giy
                        giyz= giy*giz
                        gixy= gix*giy
*                                                                      
                        gia1= 3.d0*gix-2.d0/3.d0*giz 
                        gib1= gix*(-0.5d0*giyz+2.d0*gixy-
     #                        0.5d0*gixz) 
                        gic1= 2.d0*gix*(-giy+giz-2.d0*gix)
                        gid1= gixx*(1.5d0*giyz-giyy-3.d0*gixy+
     #                        0.5d0*gixz)
                        gia2= 2.5d0*gix 
                        gib2= gix*(-0.75d0*giyz+3.d0*gixy-
     #                        0.75d0*gixz)
                        gic2= gix*(-giy+giz-4.d0*gix)
                        gid2= gixx*(2.25d0*giyz-1.5d0*giyy-4.5d0*
     #                        gixy+0.75d0*gixz)
                        gia3= -1.5d0*gix-1.d0/3.d0*(giy-giz) 
                        gib3= gix*(1.25d0*giyz-giyy-2.d0*gixy+
     #                        0.25d0*gixz)
                        gic3= gix*(3.d0*giy-giz+2.d0*gix)
                        gid3= gix*(-0.5d0*giyy*giz-2.25d0*gixy*giz+
     #                        3.5d0*gix*giyy+2.5d0*gixx*giy-0.25d0*
     #                        gixx*giz)
                        gia4= -4.d0/3.d0*giy 
                        gib4= giy*(4.d0*gixz-44.d0/3.d0*gixy-4.d0*
     #                        gixx+1.d0/3.d0*giyz) 
                        gie4= 5.d0*gix*giy*(0.5d0*giy*giyz+1.5d0*gixz*
     #                        giy-3.d0*gixy*giy-gixx*giy)
                        gic4= 8.d0*gixy
                        gid4= 2.d0*gix*giy*(-3.d0*giyz+2.d0*giyy-
     #                        3.d0*gixz+18.d0*gix*giy+2.d0*gixx)
                        gif4= 5.d0*gixx*giyy*(-2.d0*giyz+giyy-2.d0*
     #                        gixz+6.d0*gixy+gixx)
*
                        c1= giy/gil*((gia1+gib1/gil)*ri0+
     #                       (gic1+gid1/gil)*rl0)
                        c2= giy/gil*((gia2+gib2/gil)*ri0+
     #                      (gic2+gid2/gil)*rl0)
                        c3= giy/gil*((gia3+gib3/gil)*ri0+
     #                      (gic3+gid3/gil)*rl0)
                        c4= giy/gil*((gia4+gib4/gil+gie4/gils)*ri0+
     #                      (gic4+gid4/gil+gif4/gils)*rl0)
*
                        tgg(1)= x15*x24/x34/x46
                        tgg(2)= x15*x24*x34/x46
                        tgg(3)= x15*x24*x46/x34
                        tgg(4)= x24/x15/x46/x34
                        tgg(5)= x46/x15/x24/x34
                        tgg(6)= x15*x46/x24/x34
                        tgg(7)= x24*x46/x15/x34
                        tgg(8)= 1.d0/x15/x24*x34*x46
                        tgg(9)= 1.d0/x15*x24*x34/x46
                        tgg(10)= x15/x24*x34*x46
                        tgg(11)= x15/x24*x34/x46
                        tgg(12)= x15*x24*x34*x46
                        tgg(13)= 1.d0/x15/x24/x34/x46
                        tgg(14)= 1.d0/x15/x24*x34/x46
                        tgg(15)= x15/x24/x34/x46
                        tgg(16)= x15/x25/x36/x45
                        tgg(17)= 1.d0/x15/x25/x36*x45
                        tgg(18)= 1.d0/x15/x25*x36/x45
                        tgg(19)= 1.d0/x15/x25/x36/x45
                        tgg(20)= x15/x25/x36*x45
                        tgg(21)= x15/x25*x36/x45
                        tgg(22)= 1.d0/x15/x25*x36*x45
                        tgg(23)= x15/x25*x36*x45
                        tgg(24)= 1.d0/x15*x24*x34*x46
*
                        itgg= 0
                        do l=1,24
                            if(tgg(l).le.0.d0) then
                               itgg= itgg+1
                            endif
                        enddo
                        if(itgg.ne.0) then
                           iz= 0
                           ifz(50)= ifz(50)+1
                           go to 4
                        endif
*
                        gi1= sqrt(tgg(1))
                        gi2= sqrt(tgg(2))
                        gi3= sqrt(tgg(3))
                        gi4= sqrt(tgg(4))
                        gi5= sqrt(tgg(5))
                        gi6= sqrt(tgg(6))
                        gi7= sqrt(tgg(7))
                        gi8= sqrt(tgg(8))
                        gi9= sqrt(tgg(9))
                        gi10= sqrt(tgg(10))
                        gi11= sqrt(tgg(11))
                        gi12= sqrt(tgg(12))
                        gi13= sqrt(tgg(13))
                        gi14= sqrt(tgg(14))
                        gi15= sqrt(tgg(15))
                        gi16= sqrt(tgg(16))
                        gi17= sqrt(tgg(17))
                        gi18= sqrt(tgg(18))
                        gi19= sqrt(tgg(19))
                        gi20= sqrt(tgg(20))
                        gi21= sqrt(tgg(21))
                        gi22= sqrt(tgg(22))
                        gi23= sqrt(tgg(23))
                        gi24= sqrt(tgg(24))
*
                        w1= -p4*x26+p29*x25
                        w2= p16-2.d0*u15
                        cpmm= c1-c2-c3
                        cpmp= c1-c2+c3
                        cppm= c1+c2-c3
                        x456i= x45i*x56i
                        gifact= -6.d0*swg
                       else
                        gifact= 0.d0
                       endif
*
*-----Bremssthralung I: common part
*
                       db1arc= 32.d0*(-gn3*x13+gn5*x23*(x13*x45-
     #                        x14*x35)+gn6*x14*x23+gn8*(-x13*
     #                        x25+x35)-gn10)
                       db1aic= 128.d0*(s1*gn5*x35-s1*gn6+s7*gn4*
     #                        x36-s8*gn4*x35+s9*gn9+s11*gn5*
     #                        x13+s15*gn4*x13)
*
*-----Bremssthralung II: common part
*
                       db2arc= 16.d0*(-gn1*x24*x36+gn2*x26+
     #                         gn3*x23+gn4*(x13*x24*x56-x13*
     #                         x26*x45-x14*x23*x56+x14*x25*x36+
     #                         x14*x26*x35+x16*x23*x45-x16*x24*
     #                         x35-x36*x45)+gn7*(-x13*x25+2.d0*
     #                         x13*x45-2.d0*x14*x35+x35)+gn9*
     #                         (-x16*x25+x56)-2.d0*gn11)
                       db2aic= 64.d0*(s3*gn4*x45-s5*gn4*x35-
     #                         s6*gn9-s7*gn4*x26+2.d0*s7*
     #                         gn7+s11*gn4*x16+s15*gn4)
*
*-----Bremssthralung III: common part
*
                       db3arc= 32.d0*(gn1*x36*(x14-x45)+gn2*
     #                         (-x16+x56)+gn3*(-x13+x35))
                       db3aic= 128.d0*(-s1*gn6-s5*gn25-s12*
     #                         gn28*x14+s15*gn1)
*
*-----Multiperipheral I: common part
*
                       dm1arc= 32.d0*(gn1*x36*(-x14+x45)+gn2*
     #                         (x16-x56)+gn6*x23*(x14-x45)+
     #                         gn10*(-1.d0+x25))
                       dm1aic= 128.d0*(s5*gn25-s11*gn6+s12*
     #                        gn28*x14-s15*gn1)
*
*-----Multiperipheral II: common part 
*
                       dm2arc= 16.d0*(gn3*x36+gn5*(x13*x25*
     #                         x46-x13*x26*x45+x14*x23*x56- 
     #                         x14*x25*x36+x14*x26*x35-x16*
     #                         x23*x45-x35*x46+x36*x45)-gn6*
     #                         x23*x46+gn7*(-2.d0*x13*x45-
     #                         x13*x56+2.d0*x14*x35+x16*x35)+
     #                         gn8*(x16*x25-x56)+gn10*x26+
     #                         2.d0*gn11)
                       dm2aic= 64.d0*(-s2*gn5*x46+s5*gn5*
     #                        x35-s7*gn5*x26-2.d0*s7*gn7+
     #                        s9*gn7-s12*gn6-s14*gn5*x13)
*
*-----Fusion common: part
*
                       dfarc= 4.d0*gn1*x36*(x14-x24-x45)+
     #                        4.d0*gn2*(-x16+x26+x56)+2.d0*
     #                        gn3*(2.d0*(x23+x35)+x36)+2.d0*
     #                        gn5*(-2.d0*x13*x23*x45-x13*
     #                        x25*x46+x13*x26*x45+2.d0*x14*
     #                        x23*x35-x14*x23*x56+x14*x25*
     #                        x36-x14*x26*x35+x16*x23*x45+
     #                        x35*x46-x36*x45)-2.d0*gn6*x23*
     #                        (2.d0*x14+x46)+2.d0*gn7*(x13*
     #                        x56-x16*x35+2.d0*x13*x45-2.d0*
     #                        x14*x35)+2.d0*gn8*(2.d0*x13*
     #                        x25-x16*x25-2.d0*x35+x56)+2.d0*
     #                        gn10*(2.d0+x26)-4.d0*gn11
                       dfaic= 8.d0*(-s1*gn4*x56+2.d0*s1*gn6-
     #                        s4*gn4*x36+s4*gn5*x23-s4*gn8*
     #                        x25/x45+s4*gn9/x45*x56+s6*gn9+
     #                        s7*gn4*(x26-x36)-s7*gn5*x23+s7*
     #                        gn8*x25/x45-s7*gn9/x45*x56+2.d0*
     #                        s7*gn7-2.d0*s8*gn1+s8*gn4*x25-
     #                        2.d0*s9*gn9-
     #                        s10*gn4*x36+s10*gn5*x23-s10*gn8*
     #                        x25/x45+s10*gn9/x45*x56-2.d0*s11*
     #                        gn6+s12*gn1-s12*gn6-s12*gn25+s12*
     #                        gn26*(-x13*x45-x14*x25+x14*x35-
     #                        x14*x56+x16*x45+x45)+2.d0*s12*
     #                        gn28*x45+s13*gn4*x14+s14*gn2/x45-
     #                        s14*gn4*x13+s14*gn10/x45+s14*
     #                        gn25*(2.d0-x34/x45)+s14*gn27*
     #                        (1.d0-x13-x14*x25/x45+x14*x35/x45-
     #                        x14/x45*x56+x16))
*
                       if(ofl.eq.'c'.or.ofl.eq.'a') then
*
      etar4= gv1*(-2*p40*x45-p45*x36+2*p46*x36)
      etar4= etar4+gv2*(2*p43+p49-2*p57-p69)
      etar4= etar4+gv3*x45i*(-p39*x46+p46*x36)
      etar4= etar4+gv3*(p36)
      etar4= etar4+gv4*(p4*p48-p4*p61+4*p4*
     #  p73+2*p7*p73-2*p8*p73-2*p11*p47-
     #  p13*p55+p15*p57+2*p15*p60-4*p15*
     #  p69+p16*x36-2*p17*p69+2*p19*x36+p29
     #  *p53-2*p29*p73-p31*p46-2*p31*p47
     #  +2*p34*p47+2*p47*x56-2*p60*x45+2*p73*
     #  x36+2*u13*x36-2*u16*x36+2*u19*x36-u34-2
     #  *u43*x36)
      etar4= etar4+gv5*x45i*(2*p13*p51*x46)
      etar4= etar4+gv5*(-2*p3*p53-2*p3*p54+2*
     #  p3*p73+2*p13*p51-2*p13*p69)
      etar4= etar4+gv7*x45i*(-p4*p71+p8*p48-
     #  p13*p72-p15*p69-p34*p46+p71*x35+
     #  u18*x35)
      etar4= etar4+gv7*(-2*p4*x26+4*p4*x36-p5-
     #  p7*x35+2*p29*x25+p29*x35-2*p43+p51+2
     #  *p57-3*p69)
      etar4= etar4+gv8*x45i*(p5*x46-p13*p55-p15
     #  *p57+p16*x36-p32*x34-p51*x46+u33)
      etar4= etar4+gv8*(x35s+p4*x26-p4*x35-2*p4
     # *x36+2*p5+p29*x25-2*p51-p52+2*p69)
      etar4= etar4+gv9*(-2*x36*x56+p8*x56+2*p11*x36
     #  +2*p31*x36-p32-p34*x35-2*p34*x36+p55
     #  -4*u6+4*u27)
      etar4= etar4+gv10*x45i*(-u28+u29)
      etar4= etar4+gv10*(-p39)
      etar4= etar4+gv11*(p56*x35)
      etar4= etar4+gv12*x45i*(2*p43-p52-p57)
      etar4= etar4+gv13*(-2*p13*p69*x45+2*u3*p73)
      etar4= etar4+gv14*(-2*p3*p75+2*p4*p67-2
     #  *p4*p73+p7*p70+p13*p72+p15*p69
     #  +p29*p70-p31*p64+p69*x45-u18*x35-u38)
      etar4= etar4+gv47*x45i*(-p72-u6+2*u27)
*
      etarpmp= gv1*(-4*p20)
      etarpmp= etarpmp+gv2*(4*x16)
      etarpmp= etarpmp+gv3*(4*x13-2*x35-2*x36)
      etarpmp= etarpmp+gv6*(2*p41+2*p42)
      etarpmp= etarpmp+gv7*(-4*p9+4*p18)
      etarpmp= etarpmp+gv10*(-2*x25-2*x26)
      etarpmp= etarpmp+gv12*(-4)
*
      etarppm= gv1*(-4*p20+4*p73)
      etarppm= etarppm+gv2*(4*x16-4*x56)
      etarppm= etarppm+gv3*(4*x13-2*x35)
      etarppm= etarppm+gv5*(-2*p71+2*p73+2*u5-
     #  2*u7+2*u13-2*u16+2*u18-2*u24)
      etarppm= etarppm+gv6*(-2*p41)
      etarppm= etarppm+gv7*(-4*p9-2*p11+4*p18+2*p34)
      etarppm= etarppm+gv8*(-2*x56+2*p31)
      etarppm= etarppm+gv10*(2*x25)
      etarppm= etarppm+gv12*(-4)
*
      etarpmm= gv1*(4*p20)
      etarpmm= etarpmm+gv2*(-4*x16)
      etarpmm= etarpmm+gv3*(-4*x13)
      etarpmm= etarpmm+gv7*(4*p9-4*p18)
      etarpmm= etarpmm+gv12*(4)
*
      etarpp= gv1*(2*p73)
      etarpp= etarpp+gv2*(-2*x56)
      etarpp= etarpp+gv3*(-2*x35+x36)
      etarpp= etarpp+gv5*(p71-p73-u5+u7-u13+u16-u18+u24)
      etarpp= etarpp+gv6*(-p42)
      etarpp= etarpp+gv7*(p11-p34)
      etarpp= etarpp+gv8*(x56-p31)
      etarpp= etarpp+gv10*(x26)
*
      etarmm= gv1*(-2*p20)
      etarmm= etarmm+gv2*(2*x16)
      etarmm= etarmm+gv6*(2*p13)
      etarmm= etarmm+gv7*(2*p9-2*p18)
      etarmm= etarmm+gv10*(-2)
      etarmm= etarmm+gv12*(-2)
* 
      etai4= s4*gv4*x45i*(4*p47*x56)
      etai4= etai4+s4*gv4*(4*x36s-4*p52-4*p60+4*p69)
      etai4= etai4+s4*gv5*x45i*(4*u28)
      etai4= etai4+s4*gv5*(4*p36-4*p40)
      etai4= etai4+s4*gv7*x45i*(-4*p43-4*p52+4*p57)
      etai4= etai4+s4*gv8*x45i*(-4*x25s-4*p49+4*p51+4*p52)
      etai4= etai4+s4*gv9*x45i*(-4*x36*x56+4*p55)
      etai4= etai4+s4*gv13*(-4*p40*x45)
      etai4= etai4+s4*gv14*x45i*(-4*u33)
      etai4= etai4+s4*gv14*(4*p43+4*p52-4*p57)
      etai4= etai4+s7*gv4*x45i*(-4*p47*x56)
      etai4= etai4+s7*gv4*(-4*x36s+4*p52+4*p60-4*p69)
      etai4= etai4+s7*gv5*x45i*(-4*u28)
      etai4= etai4+s7*gv5*(-4*p36+4*p40)
      etai4= etai4+s7*gv7*x45i*(4*p43+4*p52-4*p57)
      etai4= etai4+s7*gv8*x45i*(4*x25s+4*p49-4*p51-4*p52)
      etai4= etai4+s7*gv9*x45i*(4*x36*x56-4*p55)
      etai4= etai4+s7*gv13*(4*p40*x45)
      etai4= etai4+s7*gv14*x45i*(4*u33)
      etai4= etai4+s7*gv14*(-4*p43-4*p52+4*p57)
      etai4= etai4+s11*gv1*(-4*x36)
      etai4= etai4+s11*gv3*x45i*(4*x25)
      etai4= etai4+s11*gv5*x45i*(-4*p16+4*u15)
      etai4= etai4+s11*gv5*(4*x25-4*p4)
      etai4= etai4+s11*gv10*x45i*(-4*x25)
      etai4= etai4+s11*gv11*(4*x36)
      etai4= etai4+s11*gv13*(-4*p73+4*u16-4*u19+4*u43)
      etai4= etai4+s12*gv1*(-4*x36)
      etai4= etai4+s12*gv3*x45i*(4*x25)
      etai4= etai4+s12*gv5*x45i*(-4*p16+4*u15)
      etai4= etai4+s12*gv5*(4*x25-4*p4)
      etai4= etai4+s12*gv10*x45i*(-4*x25)
      etai4= etai4+s12*gv11*(4*x36)
      etai4= etai4+s12*gv13*(-4*p73+4*u16-4*u19+4*u43)
      etai4= etai4+s13*gv2*(-4)
      etai4= etai4+s13*gv3*x45i*(-4*x24)
      etai4= etai4+s13*gv7*x45i*(4*p15-4*p18)
      etai4= etai4+s13*gv7*(-4+4*x13)
      etai4= etai4+s13*gv11*(4*x34)
      etai4= etai4+s13*gv12*x45i*(4)
      etai4= etai4+s13*gv14*(-4*x45+4*p9+4*p15-4*p18)
      etai4= etai4+s14*gv1*x45i*(4*p47)
      etai4= etai4+s14*gv2*x45i*(-8*x36)
      etai4= etai4+s14*gv4*x45i*(-4*u16+4*u19)
      etai4= etai4+s14*gv4*(-4*x13*x36+4*x36)
      etai4= etai4+s14*gv11*x45i*(4*p65)
      etai4= etai4+s14*gv14*x45i*(4*u16-4*u19)
      etai4= etai4+s14*gv14*(4*x13*x36-4*x36)
      etai4= etai4+s15*gv1*x45i*(4*p45)
      etai4= etai4+s15*gv2*x45i*(-8*x25)
      etai4= etai4+s15*gv4*x45i*(-4*p16+4*u15)
      etai4= etai4+s15*gv4*(4*x25-4*p4)
      etai4= etai4+s15*gv11*x45i*(4*p50)
      etai4= etai4+s15*gv14*x45i*(4*p16-4*u15)
      etai4= etai4+s15*gv14*(-4*x25+4*p4)
*
      etaipmp= s7*gv7*(-16)
      etaipmp= etaipmp+s8*gv1*(16)
      etaipmp= etaipmp+s11*gv6*(8)
      etaipmp= etaipmp+s12*gv6*(8)
*
      etaippm= s7*gv7*(-16)
      etaippm= etaippm+s8*gv1*(16)
      etaippm= etaippm+s10*gv4*(8*x36)
      etaippm= etaippm+s10*gv5*(-8*x23)
      etaippm= etaippm+s10*gv8*x45i*(8*x25)
      etaippm= etaippm+s10*gv9*x45i*(-8*x56)
      etaippm= etaippm+s11*gv6*(8)
      etaippm= etaippm+s12*gv13*(-8*x16*x45+8*p22)
      etaippm= etaippm+s12*gv36*(-16*x45)
      etaippm= etaippm+s14*gv10*x45i*(-8)
      etaippm= etaippm+s14*gv11*(-16)
      etaippm= etaippm+s14*gv14*x45i*(8*p22)
      etaippm= etaippm+s14*gv14*(-8*x16)
*
      etaipmm= s7*gv7*(16)
      etaipmm= etaipmm+s8*gv1*(-16)
*
      etaipp= s1*gv5*(4*x56)
      etaipp= etaipp+s4*gv5*x45i*(-2*p71)
      etaipp= etaipp+s4*gv8*x45i*(2*x56)
      etaipp= etaipp+s4*gv13*(-2*p73)
      etaipp= etaipp+s4*gv14*(2*x56)
      etaipp= etaipp+s5*gv5*(4*x35)
      etaipp= etaipp+s5*gv13*(2*p70-2*p73)
      etaipp= etaipp+s6*gv8*(-4)
      etaipp= etaipp+s7*gv4*(2*x56)
      etaipp= etaipp+s7*gv5*x45i*(-2*p54)
      etaipp= etaipp+s7*gv5*(-4*x25)
      etaipp= etaipp+s7*gv7*x45i*(2*x56)
      etaipp= etaipp+s7*gv13*(2*p61)
      etaipp= etaipp+s8*gv13*(2*p53+2*p61)
      etaipp= etaipp+s9*gv4*(4*x45)
      etaipp= etaipp+s10*gv4*(-2*x35-2*x36)
      etaipp= etaipp+s10*gv5*(4*x23)
      etaipp= etaipp+s10*gv14*(2*x25+2*x26)
      etaipp= etaipp+s11*gv5*x45i*(2*p22)
      etaipp= etaipp+s11*gv5*(2*x16)
      etaipp= etaipp+s11*gv6*x45i*(-2*x46)
      etaipp= etaipp+s11*gv6*(2)
      etaipp= etaipp+s11*gv13*(-2*x16*x45+2*p22)
      etaipp= etaipp+s14*gv5*x45i*(-4*p18)
      etaipp= etaipp+s14*gv10*x45i*(4)
      etaipp= etaipp+s14*gv13*(-2*p18+2*p20)
      etaipp= etaipp+s15*gv1*(-4)
      etaipp= etaipp+s15*gv13*(-2*p15-2*p17)
*
      etaimm= s1*gv5*(4*x45)
      etaimm= etaimm+s1*gv6*(-4)
      etaimm= etaimm+s4*gv8*(6)
      etaimm= etaimm+s4*gv10*x45i*(2)
      etaimm= etaimm+s4*gv13*(2*p20)
      etaimm= etaimm+s4*gv14*x45i*(-2*p22)
      etaimm= etaimm+s5*gv11*(2)
      etaimm= etaimm+s5*gv13*(-2*p18)
      etaimm= etaimm+s5*gv14*(-2*x45)
      etaimm= etaimm+s7*gv3*x45i*(-2)
      etaimm= etaimm+s7*gv4*x45i*(-2*p22)
      etaimm= etaimm+s7*gv5*x45i*(4*p15)
      etaimm= etaimm+s7*gv7*(2)
      etaimm= etaimm+s7*gv13*(-2*p17)
      etaimm= etaimm+s8*gv1*(6)
      etaimm= etaimm+s8*gv4*(2*x45)
      etaimm= etaimm+s8*gv13*(-2*p15)
      etaimm= etaimm+s9*gv4*(-4*x14)
      etaimm= etaimm+s10*gv4*x45i*(2*p18)
      etaimm= etaimm+s10*gv14*x45i*(-2*p15)
      etaimm= etaimm+s11*gv5*(4*x14)
      etaimm= etaimm+s11*gv6*x45i*(2*x14)
      etaimm= etaimm+s11*gv13*x45i*(-2*p22*x14)
      etaimm= etaimm+s11*gv13*(2*p12)
      etaimm= etaimm+s14*gv11*x45i*(-2*x14)
      etaimm= etaimm+s14*gv13*x45i*(2*p18*x14)
      etaimm= etaimm+s14*gv14*(2*x14)
      etaimm= etaimm+s15*gv1*x45i*(-2*x14)
      etaimm= etaimm+s15*gv4*(-2*x14)
      etaimm= etaimm+s15*gv13*x45i*(2*p15*x14)
*
      if(ofl.eq.'c') then 
       dfavr= -(ecv4ar*etar4+(ecv1ar-ecv2ar+ecv3ar)*etarpmp+
     #         (ecv1ar+ecv2ar-ecv3ar)*etarppm+
     #         (ecv1ar-ecv2ar-ecv3ar)*etarpmm+(ecv5ar+ecv6ar)*
     #         etarpp+(ecv5ar-ecv6ar)*etarmm)/32.d0/pis
       dfavie= -(ecv4ar*etai4+(ecv1ar-ecv2ar+ecv3ar)*etaipmp+
     #         (ecv1ar+ecv2ar-ecv3ar)*etaippm+
     #         (ecv1ar-ecv2ar-ecv3ar)*etaipmm+(ecv5ar+ecv6ar)*
     #         etaipp+(ecv5ar-ecv6ar)*etaimm)/32.d0/pis
       dfavi= -(ecv4ai*etar4+(ecv1ai-ecv2ai+ecv3ai)*etarpmp+
     #         (ecv1ai+ecv2ai-ecv3ai)*etarppm+
     #         (ecv1ai-ecv2ai-ecv3ai)*etarpmm+(ecv5ai+ecv6ai)*
     #         etarpp+(ecv5ai-ecv6ai)*etarmm)/32.d0/pis
       dfavre= (ecv4ai*etai4+(ecv1ai-ecv2ai+ecv3ai)*etaipmp+
     #         (ecv1ai+ecv2ai-ecv3ai)*etaippm+
     #         (ecv1ai-ecv2ai-ecv3ai)*etaipmm+(ecv5ai+ecv6ai)*
     #         etaipp+(ecv5ai-ecv6ai)*etaimm)/32.d0/pis
      else if(ofl.eq.'a') then
       dfavr= (ecv4ar*etar4+(ecv1ar-ecv2ar+ecv3ar)*etarpmp+
     #        (ecv1ar+ecv2ar-ecv3ar)*etarppm+
     #        (ecv1ar-ecv2ar-ecv3ar)*etarpmm+(ecv5ar+ecv6ar)*
     #         etarpp+(ecv5ar-ecv6ar)*etarmm)*4.d0
       dfavie= (ecv4ar*etai4+(ecv1ar-ecv2ar+ecv3ar)*etaipmp+
     #         (ecv1ar+ecv2ar-ecv3ar)*etaippm+
     #         (ecv1ar-ecv2ar-ecv3ar)*etaipmm+(ecv5ar+ecv6ar)*
     #         etaipp+(ecv5ar-ecv6ar)*etaimm)*4.d0
       dfavi= (ecv4ai*etar4+(ecv1ai-ecv2ai+ecv3ai)*etarpmp+
     #        (ecv1ai+ecv2ai-ecv3ai)*etarppm+
     #        (ecv1ai-ecv2ai-ecv3ai)*etarpmm+(ecv5ai+ecv6ai)*
     #         etarpp+(ecv5ai-ecv6ai)*etarmm)*4.d0
       dfavre= -(ecv4ai*etai4+(ecv1ai-ecv2ai+ecv3ai)*etaipmp+
     #         (ecv1ai+ecv2ai-ecv3ai)*etaippm+
     #         (ecv1ai-ecv2ai-ecv3ai)*etaipmm+(ecv5ai+ecv6ai)*
     #         etaipp+(ecv5ai-ecv6ai)*etaimm)/4.d0
      endif
*
                       endif        

*
                       if(ofl.eq.'y') then
                        dfagirc= 
     #                           gi1*(x56i*c4*(-p60*x45+p69*x45+0.5d0*
     #                           p73*x36-u34)+(-p47-2.d0*p73)*(c1-c2)+
     #                           c3*(p47-2.d0*p73)+c4*p47)
                        dfagirc= dfagirc+
     #                           gi2*((x26+2.d0*x56)*(c1-c2)+c3*(-x26+
     #                           2.d0*x56)+c4*(x25-0.5d0*x36))
                        dfagirc= dfagirc+
     #                           gi3*(x456i*c4*x46*(-0.5d0*p52+p57)+
     #                           0.5d0*x45i*c4*(-p42+p47)+0.5d0*x56i*c4*
     #                           (x36s-3.d0*p52+2.d0*(p57-p60+p69))+c1*
     #                           (x23+2.d0*x35+x36)+c2*(-x23+x36)+c3*(-
     #                           x23-x36)-c4*x23)
                        dfagirc= dfagirc+
     #                           gi4*(0.5d0*x56i*c4*p34*p73+cpmm*(p73+
     #                           u7+u13-u16-u18+2.d0*u19-u24-2.d0*u43-
     #                           u44+u45)+c4*(-u19+0.5d0*u43))
                        dfagirc= dfagirc+
     #                           gi5*(0.5d0*x456i*c4*(-p5*x46s-p15*p57*
     #                           x46+p16*p74+p51*x46s)-0.5d0*x45i*c4*
     #                           p13*p54+0.5d0*x56i*c4*(p4*p61+p4*p73+
     #                           p4*p74-p5*x46-p7*p73-p15*p57+p16*x36+
     #                           p17*p69+p29*p53+p29*p54-p29*p73+p51*
     #                           x46-p52*x46-p69*x45-p69*x46+p73*x36+u5*
     #                           x26-u16*x36-u34)+cpmp*(p71-p73-u5+u7-
     #                           u13+u16-u18+u24)+0.5d0*c4*p13*(-x25+
     #                           x36))
                        dfagirc= dfagirc+
     #                           gi6*(0.5d0*x456i*c4*u28*x46+x56i*c4*
     #                           (p36*x45-1.5d0*p40*x45-0.5d0*p40*x46+
     #                           1.5d0*u28)-c1*p42+(c2-c3)*(-2.d0*p41-
     #                           p42))
                        dfagirc= dfagirc+
     #                           gi7*(-0.5d0*x456i*c4*p31*p71+0.5d0*
     #                           x45i*c4*(-p71+2.d0*u5+u13-u16-u18-u44+
     #                           u45)+0.5d0*x56i*c4*(p34*x36-u27)+(c1-
     #                           c2)*(-x35+p4+p11-p34)+c3*(x35-p4+p11-
     #                           p34)+0.5d0*c4*(-x13*x36+x36+p4+p7-p29))
                        dfagirc= dfagirc+
     #                           gi8*(0.5d0*x456i*c4*p32*x46+x45i*c4*(-
     #                           0.5d0*p54+u14)+x56i*c4*(-p31*x26+0.5d0*
     #                           p31*x36-0.5d0*p32+u27)+(x56-p31)*cpmp+
     #                           0.5d0*c4*(x25-x35-x36-p4))
                        dfagirc= dfagirc+
     #                           gi9*(cpmm*(-x56+2.d0*p11+p31-2.d0*p34)+
     #                           0.5d0*c4*(-p11+p34))
                        dfagirc= dfagirc+
     #                           gi10*(-0.5d0*x456i*c4*p49*x46+x56i*c4*
     #                           (-x25s-1.5d0*p49+p51+p52+0.5d0*p60)+
     #                           c1*x26+(c2-c3)*(2.d0*x25+x26)+0.5d0*
     #                           c4*x23)
                        dfagirc= dfagirc+
     #                           gi11*c4*(x56i*(0.5d0*p60*x45+u34-u36)+
     #                           p41-p50-0.5d0*p56)
                        dfagirc= dfagirc-
     #                           0.5d0*gi12*x45i*c4*x26
                        dfagirc= dfagirc+
     #                           0.5d0*gi13*c4*(x56i*(p17*p69*x45+p73*(
     #                           p73-u7-u16-u24))+p13*p73)
                        dfagirc= dfagirc+
     #                           gi14*c4*(x56i*(0.5d0*p31*p73-p34*p61)+
     #                           0.5d0*(p67-2.d0*p73+u7-u13+u16+u18+u24-
     #                           u26))
                        dfagirc= dfagirc-
     #                           gi15*x56i*c4*p40*x45s+0.5d0*gi24*x45i*
     #                           c4*(x56-p31)
*
                        dfagiic=
     #                           4.d0*(-s1*gi4*x56+s6*gi9+s7*gi4*(x26-
     #                           2.d0*x36)+s8*gi4*x25-2.d0*s9*gi9)*cpmm
                        dfagiic= dfagiic+
     #                           2.d0*s10*gi4*(c4*(x45i*p47+x56i*(x36s-
     #                           p52-p60+p69))-2.d0*x36*cpmp)
                        dfagiic= dfagiic+
     #                           2.d0*s10*gi5*(c4*(x456i*u28+x56i*(p36-
     #                           p40))+2.d0*x23*cpmp)
                        dfagiic= dfagiic+
     #                           2.d0*s10*gi7*c4*(x456i*(-p52+p57)-x45i*
     #                           x23)
                        dfagiic= dfagiic+
     #                           2.d0*s10*gi8*x45i*(x56i*c4*(-x25s-p49+
     #                           p51+p52)-2.d0*x25*cpmp)
                        dfagiic= dfagiic+
     #                           2.d0*s10*gi9*(2.d0*x45i*x56*cpmp+x45i*
     #                           c4*(x25-x36))
                        dfagiic= dfagiic+
     #                           2.d0*s10*c4*(-gi13*x56i*p40*x45-gi14*
     #                           x45i*p50+gi14*x56i*(p52-p57)+gi14*x23)
                        dfagiic= dfagiic+
     #                           2.d0*s11*(gi5*c4*(-x45i*p15+x56i*p31)+
     #                           gi6*(x456i*c4*p54+x56i*c4*(2.d0*x25-
     #                           x36)-4.d0*c1)+gi13*c4*(-x56i*p73*x16+
     #                           p20)-2.d0*gi15*x56i*c4*p73)
                        dfagiic= dfagiic+
     #                           2.d0*s12*(gi5*c4*(-x45i*p15+x56i*p31)+
     #                           gi6*(x456i*c4*p54+x56i*c4*(2.d0*x25-
     #                           x36)-2.d0*cppm)+gi13*(-x56i*c4*p73*x16+
     #                           2.d0*cpmp*(x16*x45-p22)+c4*p20)+gi15*
     #                           (-2.d0*x56i*c4*p73+4.d0*x45*cpmp))
                        dfagiic= dfagiic+
     #                           2.d0*s13*(gi3*x56i*c4*(-x45i*x46-2.d0)+
     #                           2.d0*gi4*x14*cpmm+gi7*c4*(x45i*x14-
     #                           x56i*x16)-gi10*x56i*c4-2.d0*gi11*x56i*
     #                           c4*x45+gi14*c4*(-x56i*x16*x45+x14))
                        dfagiic= dfagiic+
     #                           2.d0*s14*(2.d0*gi1*x56i*c4*x36+gi3*
     #                           x456i*c4*x36+gi4*(-x45i*c4*p20+x56i*
     #                           c4*x16*x36-2.d0*x13*cpmm)+gi10*(-
     #                           x456i*c4*x36+2.d0*x45i*cpmp)+2.d0*gi11*
     #                           (-x56i*c4*x36+2.d0*cpmp)+gi14*(-2.d0*
     #                           x45i*cpmp*p22+x45i*c4*p20-x56i*c4*x16*
     #                           x36+2.d0*x16*cpmp))
                        dfagiic= dfagiic+
     #                           2.d0*s15*c4*(2.d0*gi1*x56i*x25+gi3*
     #                           x456i*x25-gi4*x45i*p15+gi4*x56i*p31-
     #                           gi10*x456i*x25-2.d0*gi11*x56i*x25+gi14*
     #                           (x45i*p15-x56i*p31))
                       else if(ofl.eq.'n'.or.ofl.eq.'e') then 
                        dfagirc= 0.d0
                        dfagiic= 0.d0
                       endif
                      endif
*
*-----complete diagrams, epsilon real and imag parts separated: 
*
*-----complete conversion diagram:
*
                      dcr= -0.25d0*dcr
                      dci= -0.25d0*dci
                      dcie= -0.25d0*dcie
                      dcre= -0.25d0*dcre
*
*-----complete annihilation diagrams:
*
                      adap= 0.5d0*(sth2*omrz+0.5d0*rz)
                      if(ofl.eq.'c'.or.ofl.eq.'a') then 
                         adapgr= 0.5d0*strrs
                         adapgi= 0.5d0*stris
                         adapzr= 0.5d0*(astrrs*rz+saimz)
                         adapzi= 0.5d0*(astrrs*aimz-srz)
                         adaavr1= daarc*cv1ar
                         adaavi1= daarc*cv1ai
                         adaavre1= -daaic*cv1ai
                         adaavie1= daaic*cv1ar
                         daavr1= (adaavr1*grs-adaavi1*gis)/g2
                         daavi1= (adaavr1*gis+adaavi1*grs)/g2
                         daavre1= (adaavre1*grs-adaavie1*gis)/g2
                         daavie1= (adaavre1*gis+adaavie1*grs)/g2
                         daavr= (adaavr*grs-adaavi*gis)/g2
                         daavi= (adaavr*gis+adaavi*grs)/g2
                         daavre= (adaavre*grs-adaavie*gis)/g2
                         daavie= (adaavre*gis+adaavie*grs)/g2
                         adaar= -(adapgr+adapzr)*daarc
                         adaai= -(adapgi+adapzi)*daarc
                         adaaie= -(adapgr+adapzr)*daaic
                         adaare= (adapgi+adapzi)*daaic
                         vrt= -1.d0/128.d0/pis
                         if(ofl.eq.'c') then
                          cadaar= adaar/g4+(daavr1*vrt+daavr)/g2
                          cadaai= adaai/g4+(daavi1*vrt+daavi)/g2
                          cadaare= adaare/g4+(daavre1*vrt+daavre)/g2
                          cadaaie= adaaie/g4+(daavie1*vrt+daavie)/g2
                         else if(ofl.eq.'a') then
                          cadaar= (adaar+daavr1+daavr)/g4
                          cadaai= (adaai+daavi1+daavi)/g4
                          cadaare= (adaare+daavre1+daavre)/g4
                          cadaaie= (adaaie+daavie1+daavie)/g4
                         endif
                         daar= cadaar*flr-cadaai*fli
                         daai= cadaai*flr+cadaar*fli
                         daare= cadaare*flr-cadaaie*fli
                         daaie= cadaare*fli+cadaaie*flr
                      else
                         daar= -adap*daarc
                         daare= 0.5d0*asth2*aimz*daaic
                         daaie= -adap*daaic
                         daai= -0.5d0*asth2*aimz*daarc
                      endif
                      if(otype.eq.'cc03') then
                         d11ar= 0.d0
                         d11are= 0.d0
                         d11ai= 0.d0
                         d11aie= 0.d0
*
                      else if(otype.eq.'cc11'.or.otype.eq.
     #                        'cc12'.or.otype.eq.'cc20') then
*
*-----complete pair production I-IV:                                
*
                       if(ofl.eq.'c'.or.ofl.eq.'a') then
                        hchdpr= tstrrs*chdp
                        hchdpi= tstris*chdp
                        hchdr= tstrrs*chd
                        hchdi= tstris*chd
                        hchupr= tstrrs*chup
                        hchupi= tstris*chup
                        hchur= tstrrs*chu
                        hchui= tstris*chu
*
                        ahcpd1r= 1.d0-tstrrs*(omchdp+hchdpr)+
     #                           tstris*hchdpi
                        ahcpd1i= -tstris*(omchdp+hchdpr)-
     #                           tstrrs*hchdpi
                        ahcpd2r= 1.d0-tstrrs*(omchd+hchdr)+
     #                           tstris*hchdi
                        ahcpd2i= -tstris*(omchd+hchdr)-
     #                           tstrrs*hchdi
                        ahcpu3r= -1.d0+tstrrs*(opchup-hchupr)+
     #                           tstris*hchupi
                        ahcpu3i= tstris*(opchup-hchupr)-
     #                           tstrrs*hchupi
                        ahcpu4r= -1.d0+tstrrs*(opchu-hchur)+
     #                           tstris*hchui
                        ahcpu4i= tstris*(opchu-hchur)-
     #                           tstrrs*hchui
*
                        bgcpd1r= 1.d0-tstrrs*opchdp-omrz*ahcpd1r
                        bgcpd1i= -tstris*opchdp-omrz*ahcpd1i
                        bgcpd2r= 1.d0-tstrrs*opchd-omrz*ahcpd2r
                        bgcpd2i= -tstris*opchd-omrz*ahcpd2i
                        bgcpu3r= 1.d0-tstrrs*omchup+omrz*ahcpu3r
                        bgcpu3i= -tstris*omchup+omrz*ahcpu3i
                        bgcpu4r= 1.d0-tstrrs*omchu+omrz*ahcpu4r
                        bgcpu4i= -tstris*omchu+omrz*ahcpu4i
*
                        agcpd1r= (bgcpd1r*ctrrsi-bgcpd1i*ctrisi)-
     #                           aimz*(ahcpd1r*ctrisi+ahcpd1i*ctrrsi) 
                        agcpd1i= (bgcpd1r*ctrisi+bgcpd1i*ctrrsi)+
     #                           aimz*(ahcpd1r*ctrrsi-ahcpd1i*ctrisi) 
                        agcpd2r= (bgcpd2r*ctrrsi-bgcpd2i*ctrisi)-
     #                           aimz*(ahcpd2r*ctrisi+ahcpd2i*ctrrsi) 
                        agcpd2i= (bgcpd2r*ctrisi+bgcpd2i*ctrrsi)+
     #                           aimz*(ahcpd2r*ctrrsi-ahcpd2i*ctrisi) 
                        agcpu3r= (bgcpu3r*ctrrsi-bgcpu3i*ctrisi)+
     #                           aimz*(ahcpu3r*ctrisi+ahcpu3i*ctrrsi) 
                        agcpu3i= (bgcpu3r*ctrisi+bgcpu3i*ctrrsi)-
     #                           aimz*(ahcpu3r*ctrrsi-ahcpu3i*ctrisi) 
                        agcpu4r= (bgcpu4r*ctrrsi-bgcpu4i*ctrisi)+
     #                           aimz*(ahcpu4r*ctrisi+ahcpu4i*ctrrsi) 
                        agcpu4i= (bgcpu4r*ctrisi+bgcpu4i*ctrrsi)-
     #                           aimz*(ahcpu4r*ctrrsi-ahcpu4i*ctrisi) 
*
                        gcpd1r= (agcpd1r*grs-agcpd1i*gis)/8.d0/g2
                        gcpd1i= (agcpd1r*gis+agcpd1i*grs)/8.d0/g2
                        gcpd2r= (agcpd2r*grs-agcpd2i*gis)/8.d0/g2
                        gcpd2i= (agcpd2r*gis+agcpd2i*grs)/8.d0/g2
                        gcpu3r= (agcpu3r*grs-agcpu3i*gis)/8.d0/g2
                        gcpu3i= (agcpu3r*gis+agcpu3i*grs)/8.d0/g2
                        gcpu4r= (agcpu4r*grs-agcpu4i*gis)/8.d0/g2
                        gcpu4i= (agcpu4r*gis+agcpu4i*grs)/8.d0/g2
*
                        adpp1ar= gcpd1r*dpp1arc
                        adpp1are= -gcpd1i*dpp1aic
                        adpp1aie= gcpd1r*dpp1aic
                        adpp1ai= gcpd1i*dpp1arc
                        adpp2ar= -gcpd2r*dpp2arc
                        adpp2are= gcpd2i*dpp2aic
                        adpp2aie= -gcpd2r*dpp2aic
                        adpp2ai= -gcpd2i*dpp2arc
                        adpp3ar= gcpu3r*dpp3arc
                        adpp3are= -gcpu3i*dpp3aic
                        adpp3aie= gcpu3r*dpp3aic
                        adpp3ai= gcpu3i*dpp3arc
                        adpp4ar= -gcpu4r*dpp4arc
                        adpp4are= gcpu4i*dpp4aic
                        adpp4aie= -gcpu4r*dpp4aic
                        adpp4ai= -gcpu4i*dpp4arc
                        dpp1ar= (adpp1ar*flmr-adpp1ai*flmi)/g2
                        dpp1ai= (adpp1ai*flmr+adpp1ar*flmi)/g2
                        dpp1are= (adpp1are*flmr-adpp1aie*flmi)/g2
                        dpp1aie= (adpp1are*flmi+adpp1aie*flmr)/g2
                        dpp3ar= (adpp3ar*flmr-adpp3ai*flmi)/g2
                        dpp3ai= (adpp3ai*flmr+adpp3ar*flmi)/g2
                        dpp3are= (adpp3are*flmr-adpp3aie*flmi)/g2
                        dpp3aie= (adpp3are*flmi+adpp3aie*flmr)/g2
                        dpp2ar= (adpp2ar*flpr-adpp2ai*flpi)/g2
                        dpp2ai= (adpp2ai*flpr+adpp2ar*flpi)/g2
                        dpp2are= (adpp2are*flpr-adpp2aie*flpi)/g2
                        dpp2aie= (adpp2are*flpi+adpp2aie*flpr)/g2
                        dpp4ar= (adpp4ar*flpr-adpp4ai*flpi)/g2
                        dpp4ai= (adpp4ai*flpr+adpp4ar*flpi)/g2
                        dpp4are= (adpp4are*flpr-adpp4aie*flpi)/g2
                        dpp4aie= (adpp4are*flpi+adpp4aie*flpr)/g2
                       else
                        hcpd1= 1.d0-tsth2*(omchdp+hchdp)
                        hcpd2= 1.d0-tsth2*(omchd+hchd)
                        hcpu3= -1.d0+tsth2*(opchup-hchup)
                        hcpu4= -1.d0+tsth2*(opchu-hchu)
*
                        gcpd1= (1.d0-tsth2*opchdp-omrz*hcpd1)*scth2
                        gcpd2= (1.d0-tsth2*opchd-omrz*hcpd2)*scth2
                        gcpu3= (1.d0-tsth2*omchup+omrz*hcpu3)*scth2
                        gcpu4= (1.d0-tsth2*omchu+omrz*hcpu4)*scth2
*
                        dpp1ar= gcpd1*dpp1arc
                        dpp1are= -hcpd1*haimz*dpp1aic              
                        dpp1aie= gcpd1*dpp1aic
                        dpp1ai= hcpd1*haimz*dpp1arc              
                        dpp2ar= -gcpd2*dpp2arc
                        dpp2are= hcpd2*haimz*dpp2aic              
                        dpp2aie= -gcpd2*dpp2aic
                        dpp2ai= -hcpd2*haimz*dpp2arc              
                        dpp3ar= gcpu3*dpp3arc
                        dpp3are= -hcpu3*haimz*dpp3aic              
                        dpp3aie= gcpu3*dpp3aic
                        dpp3ai= hcpu3*haimz*dpp3arc              
                        dpp4ar= -gcpu4*dpp4arc
                        dpp4are= hcpu4*haimz*dpp4aic              
                        dpp4aie= -gcpu4*dpp4aic
                        dpp4ai= -hcpu4*haimz*dpp4arc              
                       endif
* 
*-----compensating the missing W and the fermion propagators
* 
                       d11ar= (dpp1ar*wpcfr-dpp1ai*wpcfi)/pfp+
     #                        (dpp2ar*wmcfr-dpp2ai*wmcfi)/pfb+
     #                        (dpp3ar*wpcfr-dpp3ai*wpcfi)/pfpb+
     #                        (dpp4ar*wmcfr-dpp4ai*wmcfi)/pf
                       d11are= (dpp1are*wpcfr-dpp1aie*wpcfi)/pfp+
     #                         (dpp2are*wmcfr-dpp2aie*wmcfi)/pfb+
     #                         (dpp3are*wpcfr-dpp3aie*wpcfi)/pfpb+
     #                         (dpp4are*wmcfr-dpp4aie*wmcfi)/pf
                       d11ai= (dpp1ar*wpcfi+dpp1ai*wpcfr)/pfp+
     #                        (dpp2ar*wmcfi+dpp2ai*wmcfr)/pfb+
     #                        (dpp3ar*wpcfi+dpp3ai*wpcfr)/pfpb+
     #                        (dpp4ar*wmcfi+dpp4ai*wmcfr)/pf
                       d11aie= (dpp1are*wpcfi+dpp1aie*wpcfr)/pfp+
     #                         (dpp2are*wmcfi+dpp2aie*wmcfr)/pfb+
     #                         (dpp3are*wpcfi+dpp3aie*wpcfr)/pfpb+
     #                         (dpp4are*wmcfi+dpp4aie*wmcfr)/pf
                      endif
                      if(otype.ne.'cc20') then
                         d20ar= 0.d0
                         d20are= 0.d0
                         d20ai= 0.d0
                         d20aie= 0.d0
                      else if(otype.eq.'cc20') then 
*
*-----complete CC20 diagrams
*
                       db1ar=  -3.125d-2/pfb*cob1a*db1arc
                       db1aie= -3.125d-2/pfb*cob1a*db1aic
                       if(ofl.eq.'c') then
                        db2ar=  1.5625d-2*x23/pf*pp14r*db2arc
                        db2aie= 1.5625d-2*x23/pf*pp14r*db2aic
                        db2ai= 0.d0
                        db2are= 0.d0
                       else
                        if(oww.eq.'r') then
                         db2ar=  1.5625d-2*x23/pf/pp14*db2arc
                         db2aie= 1.5625d-2*x23/pf/pp14*db2aic
                         db2ai= 0.d0
                         db2are= 0.d0
                        else if(oww.eq.'f'.or.oww.eq.'i') then
                         db2ar=  1.5625d-2*x23/pf*pp14r*db2arc
                         db2aie= 1.5625d-2*x23/pf*pp14r*db2aic
                         db2ai=  1.5625d-2*x23/pf*pp14i*db2arc
                         db2are= -1.5625d-2*x23/pf*pp14i*db2aic
                        endif 
                       endif
                       if(ofl.eq.'c') then
                        db3ar= x23*vel23/128.d0/ctr23/pn*pp23r*
     #                         db3arc
                        db3aie= x23*vel23/128.d0/ctr23/pn*pp23r*
     #                          db3aic
                        dbar= db1ar+db2ar+db3ar
                        dbaie= db1aie+db2aie+db3aie
                        dbai= db2ai
                        dbare= db2are
                       else
                        db3ar= x23*vel/128.d0/cth2/pn/x23z*db3arc
                        db3aie= x23*vel/128.d0/cth2/pn/x23z*db3aic
                        dbar= db1ar+db2ar+db3ar
                        dbaie= db1aie+db2aie+db3aie
                        dbai= db2ai
                        dbare= db2are
                       endif
                       if(ofl.eq.'c') then
                        dm1ar=  3.125d-2*pp14r/pm23*com1a*dm1arc
                        dm1aie= 3.125d-2*pp14r/pm23*com1a*dm1aic
                        dm2ar=  3.125d-2*pp14r/pm24*com2a*dm2arc
                        dm2aie= 3.125d-2*pp14r/pm24*com2a*dm2aic
                        dm1ai= 0.d0
                        dm1are= 0.d0
                        dm2ai= 0.d0
                        dm2are= 0.d0
                       else
                        if(oww.eq.'r') then 
                         dm1ar=  3.125d-2/pp14/pm23*com1a*dm1arc
                         dm1aie= 3.125d-2/pp14/pm23*com1a*dm1aic
                         dm2ar=  3.125d-2/pp14/pm24*com2a*dm2arc
                         dm2aie= 3.125d-2/pp14/pm24*com2a*dm2aic
                         dm1ai= 0.d0
                         dm1are= 0.d0
                         dm2ai= 0.d0
                         dm2are= 0.d0
                        else if(oww.eq.'f'.or.oww.eq.'i') then
                         dm1ar=  3.125d-2*pp14r/pm23*com1a*dm1arc
                         dm1aie= 3.125d-2*pp14r/pm23*com1a*dm1aic
                         dm2ar=  3.125d-2*pp14r/pm24*com2a*dm2arc
                         dm2aie= 3.125d-2*pp14r/pm24*com2a*dm2aic
                         dm1ai=  3.125d-2*pp14i/pm23*com1a*dm1arc
                         dm1are= -3.125d-2*pp14i/pm23*com1a*dm1aic
                         dm2ai=  3.125d-2*pp14i/pm24*com2a*dm2arc
                         dm2are= -3.125d-2*pp14i/pm24*com2a*dm2aic
                        endif
                       endif
                       dmar= dm1ar+dm2ar
                       dmaie= dm1aie+dm2aie
                       dmai= dm1ai+dm2ai
                       dmare= dm1are+dm2are
                       if(ofl.eq.'c') then
                          dfar=  1.25d-1*(pp14rb*cofad*dfarc-
     #                           0.5d0*g2*pp14r*dfavr)
                          dfaie= 1.25d-1*(pp14rb*cofad*dfaic-
     #                           0.5d0*g2*pp14r*dfavie)
                          dfare= -6.25d-2*pp14r*g2*dfavre
                          dfai= -6.25d-2*pp14r*g2*dfavi
                       else if(ofl.eq.'a') then
                        if(oww.eq.'r') then 
                           dfar= 1.25d-1/pp14*(cofad*dfarc-
     #                            0.5d0*dfavr)
                           dfaie= 1.25d-1/pp14*(cofad*dfaic-
     #                            0.5d0*dfavie)
                           dfare= -6.25d-2/pp14*dfavre
                           dfai= -6.25d-2/pp14*dfavi
                        else if(oww.eq.'f'.or.oww.eq.'i') then
                           dfar=  1.25d-1*pp14r*(cofad*dfarc-
     #                            0.5d0*dfavr)
                           dfaie= 1.25d-1*pp14r*(cofad*dfaic-
     #                            0.5d0*dfavie)
                           dfare= -1.25d-1*pp14i*cofad*dfaic-
     #                            6.25d-2*pp14r*dfavre
                           dfai= 1.25d-1*pp14i*cofad*dfarc-
     #                           6.25d-2*pp14r*dfavi
                        endif 
                       else
                        if(oww.eq.'r') then
                           dfar=  1.25d-1/pp14*cofad*dfarc
                           dfaie= 1.25d-1/pp14*cofad*dfaic
                        else if(oww.eq.'f'.or.oww.eq.'i') then
                           dfar=  1.25d-1*pp14r*cofad*dfarc
                           dfaie= 1.25d-1*pp14r*cofad*dfaic
                        endif
                       endif
                       if(ofl.eq.'y') then
                          dfai= 6.25d-2/pp14*cofad*gifact*dfagirc
                          dfare= -6.25d-2/pp14*cofad*gifact*dfagiic
                       else if(ofl.eq.'e') then
                          gfct= swg*x56/(x56+x14)
                          dfai= 1.25d-1/pp14*cofad*gfct*dfarc
                          dfare= -1.25d-1/pp14*cofad*gfct*dfaic
                       else if(ofl.eq.'n') then
                          if(oww.eq.'f'.or.oww.eq.'i') then
                             dfai= 1.25d-1*pp14i*cofad*dfarc
                             dfare= -1.25d-1*pp14i*cofad*dfaic
                          else
                             dfai= 0.d0
                             dfare= 0.d0
                          endif
                       endif
*
*-----compensating the missing W propagators
* 
                       d20asrr= dbar+dfar
                       d20asrie= dbaie+dfaie
                       d20asri= dbai+dfai
                       d20asrre= dbare+dfare
                       if(ofl.eq.'c') then
                        d20ar= (d20asrr*flpr-d20asri*flpi)/g2+
     #                         wpcfr*dmar-wpcfi*dmai
                        d20are= (d20asrre*flpr-d20asrie*flpi)/g2-
     #                          wpcfi*dmaie+wpcfr*dmare
                        d20aie= (d20asrre*flpi+d20asrie*flpr)/g2+
     #                          wpcfr*dmaie+wpcfi*dmare
                        d20ai= (d20asri*flpr+d20asrr*flpi)/g2+
     #                         wpcfi*dmar+wpcfr*dmai 
                       else
                        d20ar= d20asrr+wpcfr*dmar-wpcfi*dmai
                        d20are= d20asrre-wpcfi*dmaie+wpcfr*dmare
                        d20aie= d20asrie+wpcfr*dmaie+wpcfi*dmare
                        d20ai= d20asri+wpcfi*dmar+wpcfr*dmai 
                       endif
*
                       cd20ar= wmcfr*d20ar-wmcfi*d20ai
                       cd20are= wmcfr*d20are-wmcfi*d20aie
                       cd20aie= wmcfr*d20aie+wmcfi*d20are
                       cd20ai= wmcfr*d20ai+wmcfi*d20ar
*
                      endif 
* 
                      if(opeaka.eq.'n'.or.opeaka.eq.'f') then
                       dtar= daar-d11ar-cd20ar/x23
                       dtare= daare-d11are-cd20are/x23
                       dtaie= daaie-d11aie-cd20aie/x23
                       dtai= daai-d11ai-cd20ai/x23
                       pns= pn*pn
                       das= (dcr/pn+dtar)*(dcr/pn+dtar)+
     #                      (dcie/pn+dtaie)*(dcie/pn+dtaie)+
     #                      (dcre/pn+dtare)*(dcre/pn+dtare)+
     #                      (dci/pn+dtai)*(dci/pn+dtai)
*
                       das0= (dcr/pn+daar)*(dcr/pn+daar)+
     #                      (dcie/pn+daaie)*(dcie/pn+daaie)+
     #                      (dcre/pn+daare)*(dcre/pn+daare)+
     #                      (dci/pn+daai)*(dci/pn+daai)
                      else if(opeaka.eq.'y') then 
                       dtar= x23*(daar-d11ar)-cd20ar
                       dtare= x23*(daare-d11are)-cd20are
                       dtaie= x23*(daaie-d11aie)-cd20aie
                       dtai= x23*(daai-d11ai)-cd20ai
                       pns= pn*pn
                       das= (x23*dcr/pn+dtar)*(x23*dcr/pn+dtar)+
     #                      (x23*dcie/pn+dtaie)*(x23*dcie/pn+dtaie)+
     #                      (x23*dcre/pn+dtare)*(x23*dcre/pn+dtare)+
     #                      (x23*dci/pn+dtai)*(x23*dci/pn+dtai)
*
                       das0= (dcr/pn+daar)*(dcr/pn+daar)+
     #                       (dcie/pn+daaie)*(dcie/pn+daaie)+
     #                       (dcre/pn+daare)*(dcre/pn+daare)+
     #                       (dci/pn+daai)*(dci/pn+daai)
                       das0= x23*x23*das0
                      endif
                      das= das+coulf*das0
                      if(oqcd.eq.'y'.and.iqcd.eq.0) then
                         das= das+qcdjac*das0*(1.d0+coulf)
                      endif
* 
*-----helicity b) 
* 
*
*-----annihilation diagrams: common part                               
*                                                                      
                      dabrc= 2.d0*gn12*(x23*x36*x45-x24*x35*
     #                       x36)+gn13*(-x13*x23*x45+x13*x24*
     #                       x35-0.5d0*x13*x24*x56+0.5d0*x13*
     #                       x26*x45-0.5d0*x15*x23*x46+0.5d0*
     #                       x15*x24*x36+0.5d0*x16*x23*x45-
     #                       0.5d0*x16*x24*x35+0.5d0*x35*x46-
     #                       0.5d0*x36*x45)+2.d0*gn14*(-x23*
     #                       x56+x26*x35)+gn15*(x23*x45+0.5d0*
     #                       x23*x56-x24*x35-0.5d0*x26*x35)+
     #                       gn16*(x15*x23-0.5d0*x15*x26-x35+
     #                       0.5d0*x56)+3.d0*gn17-2.d0*gn20*
     #                       x56+gn21*(-x35+1.5d0*x36)+2.d0*
     #                       gn22*x36*x45+gn23*(x15+1.5d0*
     #                       x16)+gn24*(-x13*x45-1.5d0*x13*
     #                       x46)
                      dabic= 8.d0*gn12*x36*s11+2.d0*gn13*(x16*s11-
     #                       2.d0*x23*s7+x23*s10+2.d0*x35*s1+x35*s5-
     #                       x46*s2)+8.d0*gn14*s13+2.d0*gn15*(2.d0*
     #                       s11-s13)-8.d0*gn18*s10-8.d0*gn19*x45*s8+
     #                       2.d0*gn24*(2.d0*s7-3.d0*s8)
* 
*-----The Fermion loop scheme starts here 
* 
      if(ofl.eq.'c'.or.ofl.eq.'a') then
*
      tbr4= gv15*(p24*p49-p24*p79+
     #  p31*p78-p32*x24-p35*x24+p45*x56-2*p49*x45
     #  +2*p61*x16)
      tbr4= tbr4+gv16*(p2*p48-p2*p61-p4*p48
     #  +p4*p61-p12*p43-p12*p52+p12*p57+p13*p55
     #  -2*p15*p27-p15*p57-2*p15*p60-p16*x36-2*p17*p27
     #  +2*p20*x56-3*p24*p52-2*p24*p60-p29*p48
     #  -p29*p53+p31*p46-p31*p47-p34*p78+p36*p48
     #  -p45*p52-p45*p57-2*p45*p60+2*p47*x56-p73*x16
     #  +u22*x16+u24*x16+u34+u45*x26)
      tbr4= tbr4+gv17*(p2*p45+2*p4*x24*x26+
     #  2*p4*p24+p5*x24+2*p7*p24+p23*p45
     #  -p23*p78-p45*x35-2*u44+u45)
      tbr4= tbr4+gv18*(p25*x16+3*p25*x25+2*p25*x26
     #  +2*p31*x15+p31*x16+2*p31*x26+p32
     #  -p35+2*p49*x25+2*p49*x26-p55-2*p63)
      tbr4= tbr4+gv19*(p2*x25+2*p4*x15+2*p4
     #  *x26+p5+2*p7*x15-2*p11-p23*x16+p23*
     #  x25+p34-p51)
      tbr4= tbr4+gv20*(2*x56-2*p25-2*p31-2*
     #  p49-2*p77)
      tbr4= tbr4+gv48*(p2*p48*x24-p2*p61*
     #  x24-p4*p48*x24+p4*p61*x24+p24*p47*x16
     #  +p31*p46*x24+p45*p73-p47*x16*x45-u22
     #  *p45-u24*p45+u24*p78-u45*p78)
*
      tbr2= gv16*(4*p40*x45-4*p46*x36)
      tbr2= tbr2+gv16*(-4*u34)
      tbr2= tbr2+gv17*(4*p4*x45+4*u5)
      tbr2= tbr2+gv18*(-4*p43+4*p57)
      tbr2= tbr2+gv18*(4*p55)
      tbr2= tbr2+gv19*(4*p41-4*p46)
      tbr2= tbr2+gv19*(-4*p52)
      tbr2= tbr2+gv20*(-4*p31-4*p77)
      tbr2= tbr2+gv46*(4*x25)
*
      tbr3= gv16*(4*p40*x45-4*p46*x36)
      tbr3= tbr3+gv16*(4*u34)
      tbr3= tbr3+gv17*(-4*p4*x45-4*u5)
      tbr3= tbr3+gv18*(-4*p43+4*p57)
      tbr3= tbr3+gv18*(-4*p55)
      tbr3= tbr3+gv19*(4*p41-4*p46)
      tbr3= tbr3+gv19*(4*p52)
      tbr3= tbr3+gv20*(4*p31+4*p77)
      tbr3= tbr3+gv46*(4*x25)
*
      tbr5= gv16*(2*u34)
      tbr5= tbr5+gv16*(-2*p40*x45+2*p46*x36)
      tbr5= tbr5+gv17*(-p71+p73+u5-u7
     #  +u21-u22-u24+u44+u45)
      tbr5= tbr5+gv17*(-2*p8*x24+2*u3)
      tbr5= tbr5+gv18*(-2*p55)
      tbr5= tbr5+gv18*(2*p43-2*p57)
      tbr5= tbr5+gv19*(-p43-2*p51-p52+p57)
      tbr5= tbr5+gv20*(-x56+p25-p31)
      tbr5= tbr5+gv20*(2*x35-2*p23)
      tbr5= tbr5+gv46*(4*x25)
*
      tbr6= gv16*(2*u34)
      tbr6= tbr6+gv16*(2*p40*x45-2*p46*x36)
      tbr6= tbr6+gv17*(-p71+p73+u5-u7
     #  +u21-u22-u24+u44+u45)
      tbr6= tbr6+gv17*(2*p8*x24-2*u3)
      tbr6= tbr6+gv18*(-2*p55)
      tbr6= tbr6+gv18*(-2*p43+2*p57)
      tbr6= tbr6+gv19*(-p43-2*p51-p52+p57)
      tbr6= tbr6+gv20*(-x56+p25-p31)
      tbr6= tbr6+gv20*(-2*x35+2*p23)
      tbr6= tbr6+gv46*(-4*x25)
*
      tbi4= s1*gv16*(4*p35)
      tbi4= tbi4+s1*gv48*(4*p35*x24-4*p45*x56)
      tbi4= tbi4+s2*gv19*(-4*x25)
      tbi4= tbi4+s4*gv15*(-8*p49+8*p79)
      tbi4= tbi4+s4*gv16*(4*p52)
      tbi4= tbi4+s5*gv15*(8*x56-8*p25-8*p31
     #  -8*p49-8*p77)
      tbi4= tbi4+s6*gv15*(-4*p45+4*p78)
      tbi4= tbi4+s6*gv18*(-4*x16+4*x25)
      tbi4= tbi4+s7*gv16*(-4*p79)
      tbi4= tbi4+s7*gv48*(4*p45*x26-4*p78*x26)
      tbi4= tbi4+s8*gv16*(4*x25s-8*x56+8*p25
     #  +4*p31+8*p49+8*p77)
      tbi4= tbi4+s8*gv48*(8*p24*x25+8*p24*
     #  x26+4*p31*x24+4*p45*x25+8*p45*x26-8*p48)
      tbi4= tbi4+s12*gv16*(4*p77)
      tbi4= tbi4+s13*gv16*(-4*p12+4*p45-4*p78)
      tbi4= tbi4+s14*gv16*(4*p2)
      tbi4= tbi4+s14*gv48*(4*p2*x24-4*p4*x24)
      tbi4= tbi4+s15*gv16*(-4*x25)
*
      tbi2= s8*gv17*(16*x25)
      tbi2= tbi2+s8*gv48*(16*p53)
      tbi2= tbi2+s10*gv15*(16*x25)
      tbi2= tbi2+s11*gv16*(16*x36)
      tbi2= tbi2+s11*gv19*(16)
      tbi2= tbi2+s13*gv18*(16)
*
      tbi3= s8*gv17*(-16*x25)
      tbi3= tbi3+s8*gv48*(-16*p53)
      tbi3= tbi3+s10*gv15*(-16*x25)
      tbi3= tbi3+s11*gv16*(16*x36)
      tbi3= tbi3+s11*gv19*(16)
      tbi3= tbi3+s13*gv18*(16)
*
      tbi5= s1*gv15*(-4*x56)
      tbi5= tbi5+s2*gv20*(-4)
      tbi5= tbi5+s3*gv15*(4*x45)
      tbi5= tbi5+s4*gv15*(-4*x56)
      tbi5= tbi5+s4*gv20*(-4)
      tbi5= tbi5+s5*gv15*(-4*x56)
      tbi5= tbi5+s5*gv15*(4*x45)
      tbi5= tbi5+s6*gv15*(-4*x45)
      tbi5= tbi5+s6*gv20*(-4)
      tbi5= tbi5+s7*gv15*(4*x26)
      tbi5= tbi5+s7*gv17*(4*x25)
      tbi5= tbi5+s7*gv48*(4*p48-4*p61)
      tbi5= tbi5+s8*gv17*(4*x25)
      tbi5= tbi5+s8*gv48*(4*p48-4*p61)
      tbi5= tbi5+s8*gv48*(4*p41-4*p46)
      tbi5= tbi5+s9*gv15*(4*x24)
      tbi5= tbi5+s10*gv15*(-4*x26)
      tbi5= tbi5+s10*gv15*(4*x24)
      tbi5= tbi5+s10*gv48*(4*p41-4*p46)
      tbi5= tbi5+s11*gv16*(-4*x36)
      tbi5= tbi5+s11*gv17*(4*x13)
      tbi5= tbi5+s12*gv15*(-4*x15)
      tbi5= tbi5+s13*gv18*(-4)
      tbi5= tbi5+s14*gv15*(-4*x15)
      tbi5= tbi5+s14*gv16*(4*x36)
      tbi5= tbi5+s14*gv17*(-4*x13)
      tbi5= tbi5+s14*gv18*(-4)
      tbi5= tbi5+s15*gv15*(4)
      tbi5= tbi5+s15*gv16*(-4*x25)
      tbi5= tbi5+s15*gv48*(-4*x45+4*p24)
*
      tbi6= s1*gv15*(4*x56)
      tbi6= tbi6+s2*gv20*(4)
      tbi6= tbi6+s3*gv15*(-4*x45)
      tbi6= tbi6+s4*gv15*(-4*x56)
      tbi6= tbi6+s4*gv20*(4)
      tbi6= tbi6+s5*gv15*(-4*x56)
      tbi6= tbi6+s5*gv15*(-4*x45)
      tbi6= tbi6+s6*gv15*(-4*x45)
      tbi6= tbi6+s6*gv20*(-4)
      tbi6= tbi6+s7*gv15*(-4*x26)
      tbi6= tbi6+s7*gv17*(4*x25)
      tbi6= tbi6+s7*gv48*(4*p48-4*p61)
      tbi6= tbi6+s8*gv17*(4*x25)
      tbi6= tbi6+s8*gv48*(4*p48-4*p61)
      tbi6= tbi6+s8*gv48*(-4*p41+4*p46)
      tbi6= tbi6+s9*gv15*(-4*x24)
      tbi6= tbi6+s10*gv15*(-4*x26)
      tbi6= tbi6+s10*gv15*(-4*x24)
      tbi6= tbi6+s10*gv48*(4*p41-4*p46)
      tbi6= tbi6+s11*gv16*(4*x36)
      tbi6= tbi6+s11*gv17*(-4*x13)
      tbi6= tbi6+s12*gv15*(4*x15)
      tbi6= tbi6+s13*gv18*(4)
      tbi6= tbi6+s14*gv15*(-4*x15)
      tbi6= tbi6+s14*gv16*(4*x36)
      tbi6= tbi6+s14*gv17*(-4*x13)
      tbi6= tbi6+s14*gv18*(4)
      tbi6= tbi6+s15*gv15*(-4)
      tbi6= tbi6+s15*gv16*(-4*x25)
      tbi6= tbi6+s15*gv48*(-4*x45+4*p24)
* 
      if(ofl.eq.'c') then
       adabvr= -(cv2br*tbr2+cv3br*tbr3+cv4br*tbr4+
     #         cv5br*tbr5+cv6br*tbr6)/256.d0/pis
       adabvie= -(cv2br*tbi2+cv3br*tbi3+cv4br*tbi4+
     #         cv5br*tbi5+cv6br*tbi6)/256.d0/pis
       adabvi= -(cv2bi*tbr2+cv3bi*tbr3+cv4bi*tbr4+
     #         cv5bi*tbr5+cv6bi*tbr6)/256.d0/pis
       adabvre= (cv2bi*tbi2+cv3bi*tbi3+cv4bi*tbi4+
     #         cv5bi*tbi5+cv6bi*tbi6)/256.d0/pis
      else if(ofl.eq.'a') then
       adabvr= 0.5d0*(cv2br*tbr2+cv3br*tbr3+cv4br*tbr4+
     #         cv5br*tbr5+cv6br*tbr6)
       adabvie= 0.5d0*(cv2br*tbi2+cv3br*tbi3+cv4br*tbi4+
     #          cv5br*tbi5+cv6br*tbi6)
       adabvi= 0.5d0*(cv2bi*tbr2+cv3bi*tbr3+cv4bi*tbr4+
     #         cv5bi*tbr5+cv6bi*tbr6)
       adabvre= -0.5d0*(cv2bi*tbi2+cv3bi*tbi3+cv4bi*tbi4+
     #          cv5bi*tbi5+cv6bi*tbi6)
      endif 
      endif
*
                      if(otype.eq.'cc03') then
                         dpp1brc= 0.d0
                         dpp1bic= 0.d0
                         dpp2brc= 0.d0
                         dpp2bic= 0.d0
                         dpp3brc= 0.d0
                         dpp3bic= 0.d0
                         dpp4brc= 0.d0
                         dpp4bic= 0.d0
*
                      else if(otype.eq.'cc11'.or.otype.eq.
     #                        'cc12'.or.otype.eq.'cc20') then
*
*-----pair production I: common pbrt                         
*
                       dpp1brc= gn12*(-x13*(x24*x56-x26*x45)+x14*
     #                          (x23*x56-x26*x35)+x15*x24*x36-x16*
     #                          (x23*x45-x24*x35)-x36*x45)+gn13*
     #                          (x13*(x24*x56-x26*x45)+x15*(x23*
     #                          x46-x24*x36)-x16*(x23*x45-x24*x35)-
     #                          x35*x46+x36*x45)+gn14*(-x15*x26+
     #                          x56)+gn15*(-x15*x23-x23*x56+x26*
     #                          x35+x35)+gn16*(x15*x26-x56)+gn20*
     #                          x16+gn21*(x13+x36)+gn22*(-x14*
     #                          x36)+gn23*x16+gn24*(-x13*x46)
                       dpp1bic= 4.d0*gn12*(-x14*s13-x16*s11+x23*
     #                          s10+x35*s5)+4.d0*gn13*(-x13*s14-
     #                          x26*s7+x56*s1)+4.d0*gn15*(-s2+s13)-
     #                          4.d0*gn16*s6+4.d0*gn22*s8-4.d0*
     #                          gn24*s8
*
*-----pair production II: common part                                   
* 
                       dpp2brc= 2.d0*gn13*x13*(-x23*x45+x24*x35)+
     #                          2.d0*gn16*(x15*x23-x35)+2.d0*gn21*
     #                          x23+2.d0*gn23-2.d0*gn24*x13*x24
                       dpp2bic= 8.d0*gn13*(-x23*s7+x35*s1)-8.d0*
     #                          gn24*s1
*
*-----production III: common part                                   
*
                       dpp3brc= 2.d0*gn21*(-x23+x35)+2.d0*gn23*
     #                          (-1.d0+x15)+2.d0*gn24*x13*(x24-x45)
                       dpp3bic= 8.d0*gn24*(s1-s7)
*
*-----pair production IV: common part                                     
* 
                       dpp4brc= gn12*(x13*(x24*x56-x26*x45)-x14*
     #                          (x23*x56-x26*x35)-x15*x24*x36+x16*
     #                          (x23*x45-x24*x35)+x36*x45)+gn14*
     #                          (x15*x26-x56)+gn15*(x15*x23-2*x23*
     #                          x45+2.d0*x24*x35-x35)+2.d0*gn17-
     #                          gn20*x16-gn21*x13+gn22*x14*x36
                       dpp4bic= 4.d0*gn12*(x14*s13+x16*s11-x23*s10-
     #                          x35*s5)+4.d0*gn15*(s2-2.d0*s11)-
     #                          4.d0*gn22*s8
                      endif 
* 
*-----complete diagrams, epsilon parts separated 
* 
*-----complete annihilation diagrams:
*
                      if(ofl.eq.'c'.or.ofl.eq.'a') then
                         adbpr= 0.5d0*(strrs*omrz+saimz)
                         adbpi= 0.5d0*(-raimz+stris*omrz)
                         bdbpr= (adbpr*grs-adbpi*gis)/g2
                         bdbpi= (adbpr*gis+adbpi*grs)/g2
                         dabvr= (adabvr*grs-adabvi*gis)/g2
                         dabvi= (adabvr*gis+adabvi*grs)/g2
                         dabvre= (adabvre*grs-adabvie*gis)/g2
                         dabvie= (adabvre*gis+adabvie*grs)/g2
                         adabr= -adbpr*dabrc
                         adabre= adbpi*dabic
                         adabi= -adbpi*dabrc
                         adabie= -adbpr*dabic
                         adabvr1= dabrc*cv1br
                         adabvi1= dabrc*cv1bi
                         adabvre1= -dabic*cv1bi
                         adabvie1= dabic*cv1br
                         dabvr1= (adabvr1*grs-adabvi1*gis)/g2
                         dabvi1= (adabvr1*gis+adabvi1*grs)/g2
                         dabvre1= (adabvre1*grs-adabvie1*gis)/g2
                         dabvie1= (adabvre1*gis+adabvie1*grs)/g2
                         vrt= -1.d0/128.d0/pis
                         if(ofl.eq.'c') then
                          cadabr= adabr/g4+(dabvr1*vrt+dabvr)/g2
                          cadabi= adabi/g4+(dabvi1*vrt+dabvi)/g2
                          cadabre= adabre/g4+(dabvre1*vrt+dabvre)/g2
                          cadabie= adabie/g4+(dabvie1*vrt+dabvie)/g2
                         else if(ofl.eq.'a') then
                          cadabr= (adabr+dabvr1+dabvr)/g4
                          cadabi= (adabi+dabvi1+dabvi)/g4
                          cadabre= (adabre+dabvre1+dabvre)/g4
                          cadabie= (adabie+dabvie1+dabvie)/g4
                         endif
                         dabr= cadabr*flr-cadabi*fli
                         dabi= cadabi*flr+cadabr*fli
                         dabre= cadabre*flr-cadabie*fli
                         dabie= cadabre*fli+cadabie*flr
                      else
                         dabr= -hsth2*omrz*dabrc
                         dabre= -hsth2*aimz*dabic
                         dabie= -hsth2*omrz*dabic
                         dabi= hsth2*aimz*dabrc
                      endif
                      if(otype.eq.'cc03') then
                         d11br= 0.d0           
                         d11bre= 0.d0
                         d11bi= 0.d0
                         d11bie= 0.d0
*
                      else if(otype.eq.'cc11'.or.otype.eq.
     #                        'cc12'.or.otype.eq.'cc20') then
*
*-----complete pair production I-IV:                                
*
                       if(ofl.eq.'c'.or.ofl.eq.'a') then
                        hchdpr= strrs*chdp
                        hchdpi= stris*chdp
                        hchdr= strrs*chd
                        hchdi= stris*chd
                        hchupr= strrs*chup
                        hchupi= stris*chup
                        hchur= strrs*chu
                        hchui= stris*chu
                        achdpr= 0.5d0+hchdpr
                        achdr= 0.5d0+hchdr
                        achupr= 0.5d0-hchupr
                        achur= 0.5d0-hchur
                        agcmd1r= ttrrs*(-0.5d0-chdp+omrz*achdpr+
     #                           aimz*hchdpi)-ttris*(omrz*hchdpi-
     #                           aimz*achdpr)
                        agcmd1i= ttrrs*(omrz*hchdpi-aimz*achdpr)+
     #                           ttris*(-0.5d0-chdp+omrz*achdpr+
     #                           aimz*hchdpi)
                        agcmd2r= ttrrs*(-0.5d0-chd+omrz*achdr+
     #                           aimz*hchdi)-ttris*(omrz*hchdi-
     #                           aimz*achdr)
                        agcmd2i= ttrrs*(omrz*hchdi-aimz*achdr)+
     #                           ttris*(-0.5d0-chd+omrz*achdr+
     #                           aimz*hchdi)
                        agcmu3r= ttrrs*(-0.5d0+chup+omrz*achupr-
     #                           aimz*hchupi)-ttris*(-omrz*hchupi-
     #                           aimz*achupr)
                        agcmu3i= ttrrs*(-omrz*hchupi-aimz*achupr)+
     #                           ttris*(-0.5d0+chup+omrz*achupr-
     #                           aimz*hchupi)
                        agcmu4r= ttrrs*(-0.5d0+chu+omrz*achur-
     #                           aimz*hchui)-ttris*(-omrz*hchui-
     #                           aimz*achur)
                        agcmu4i= ttrrs*(-omrz*hchui-aimz*achur)+
     #                           ttris*(-0.5d0+chu+omrz*achur-
     #                           aimz*hchui)
*
                        gcmd1r= (agcmd1r*grs-agcmd1i*gis)/2.d0/g2
                        gcmd1i= (agcmd1r*gis+agcmd1i*grs)/2.d0/g2
                        gcmd2r= (agcmd2r*grs-agcmd2i*gis)/2.d0/g2
                        gcmd2i= (agcmd2r*gis+agcmd2i*grs)/2.d0/g2
                        gcmu3r= (agcmu3r*grs-agcmu3i*gis)/2.d0/g2
                        gcmu3i= (agcmu3r*gis+agcmu3i*grs)/2.d0/g2
                        gcmu4r= (agcmu4r*grs-agcmu4i*gis)/2.d0/g2
                        gcmu4i= (agcmu4r*gis+agcmu4i*grs)/2.d0/g2
*
                        adpp1br= gcmd1r*dpp1brc
                        adpp1bre= -gcmd1i*dpp1bic
                        adpp1bie= gcmd1r*dpp1bic
                        adpp1bi= gcmd1i*dpp1brc
                        adpp2br= -gcmd2r*dpp2brc
                        adpp2bre= gcmd2i*dpp2bic
                        adpp2bie= -gcmd2r*dpp2bic
                        adpp2bi= -gcmd2i*dpp2brc
                        adpp3br= gcmu3r*dpp3brc
                        adpp3bre= -gcmu3i*dpp3bic
                        adpp3bie= gcmu3r*dpp3bic
                        adpp3bi= gcmu3i*dpp3brc
                        adpp4br= -gcmu4r*dpp4brc
                        adpp4bre= gcmu4i*dpp4bic
                        adpp4bie= -gcmu4r*dpp4bic
                        adpp4bi= -gcmu4i*dpp4brc
                        dpp1br= (adpp1br*flmr-adpp1bi*flmi)/g2
                        dpp1bi= (adpp1bi*flmr+adpp1br*flmi)/g2
                        dpp1bre= (adpp1bre*flmr-adpp1bie*flmi)/g2
                        dpp1bie= (adpp1bre*flmi+adpp1bie*flmr)/g2
                        dpp3br= (adpp3br*flmr-adpp3bi*flmi)/g2
                        dpp3bi= (adpp3bi*flmr+adpp3br*flmi)/g2
                        dpp3bre= (adpp3bre*flmr-adpp3bie*flmi)/g2
                        dpp3bie= (adpp3bre*flmi+adpp3bie*flmr)/g2
                        dpp2br= (adpp2br*flpr-adpp2bi*flpi)/g2
                        dpp2bi= (adpp2bi*flpr+adpp2br*flpi)/g2
                        dpp2bre= (adpp2bre*flpr-adpp2bie*flpi)/g2
                        dpp2bie= (adpp2bre*flpi+adpp2bie*flpr)/g2
                        dpp4br= (adpp4br*flpr-adpp4bi*flpi)/g2
                        dpp4bi= (adpp4bi*flpr+adpp4br*flpi)/g2
                        dpp4bre= (adpp4bre*flpr-adpp4bie*flpi)/g2
                        dpp4bie= (adpp4bre*flpi+adpp4bie*flpr)/g2
                       else
                        gcmd1= tth2*(-0.25d0-0.5d0*chdp+omrz*(0.25d0+
     #                         chdp*hsth2))       
                        gcmd2= tth2*(-0.25d0-0.5d0*chd+omrz*(0.25d0+
     #                         chd*hsth2))       
                        gcmu3= tth2*(-0.25d0+0.5d0*chup+omrz*(0.25d0-
     #                         chup*hsth2))       
                        gcmu4= tth2*(-0.25d0+0.5d0*chu+omrz*(0.25d0-
     #                         chu*hsth2))       
                        hcmd1= -tsth2*(1.d0+hchdp)
                        hcmd2= -tsth2*(1.d0+hchd)
                        hcmu3= tsth2*(1.d0-hchup)
                        hcmu4= tsth2*(1.d0-hchu)
*
                        dpp1br= gcmd1*dpp1brc
                        dpp1bre= -hcmd1*haimz*dpp1bic              
                        dpp1bie= gcmd1*dpp1bic
                        dpp1bi= hcmd1*haimz*dpp1brc              
                        dpp2br= -gcmd2*dpp2brc
                        dpp2bre= hcmd2*haimz*dpp2bic              
                        dpp2bie= -gcmd2*dpp2bic
                        dpp2bi= -hcmd2*haimz*dpp2brc              
                        dpp3br= gcmu3*dpp3brc
                        dpp3bre= -hcmu3*haimz*dpp3bic              
                        dpp3bie= gcmu3*dpp3bic
                        dpp3bi= hcmu3*haimz*dpp3brc              
                        dpp4br= -gcmu4*dpp4brc
                        dpp4bre= hcmu4*haimz*dpp4bic              
                        dpp4bie= -gcmu4*dpp4bic
                        dpp4bi= -hcmu4*haimz*dpp4brc              
                       endif
*                 
*-----compensating the missing W and the fermion propagators
*
                       d11br= (dpp1br*wpcfr-dpp1bi*wpcfi)/pfp+
     #                        (dpp2br*wmcfr-dpp2bi*wmcfi)/pfb+
     #                        (dpp3br*wpcfr-dpp3bi*wpcfi)/pfpb+
     #                        (dpp4br*wmcfr-dpp4bi*wmcfi)/pf
                       d11bre= (dpp1bre*wpcfr-dpp1bie*wpcfi)/pfp+
     #                         (dpp2bre*wmcfr-dpp2bie*wmcfi)/pfb+
     #                         (dpp3bre*wpcfr-dpp3bie*wpcfi)/pfpb+
     #                         (dpp4bre*wmcfr-dpp4bie*wmcfi)/pf
                       d11bi= (dpp1br*wpcfi+dpp1bi*wpcfr)/pfp+
     #                        (dpp2br*wmcfi+dpp2bi*wmcfr)/pfb+
     #                        (dpp3br*wpcfi+dpp3bi*wpcfr)/pfpb+
     #                        (dpp4br*wmcfi+dpp4bi*wmcfr)/pf
                       d11bie= (dpp1bre*wpcfi+dpp1bie*wpcfr)/pfp+
     #                         (dpp2bre*wmcfi+dpp2bie*wmcfr)/pfb+
     #                         (dpp3bre*wpcfi+dpp3bie*wpcfr)/pfpb+
     #                         (dpp4bre*wmcfi+dpp4bie*wmcfr)/pf
                      endif
*
                      dbs= (dabr-d11br)*(dabr-d11br)+
     #                     (dabre-d11bre)*(dabre-d11bre)+
     #                     (dabie-d11bie)*(dabie-d11bie)+
     #                     (dabi-d11bi)*(dabi-d11bi)
                      dbs0= (dabr*dabr+dabre*dabre+
     #                       dabie*dabie+dabi*dabi)
                      if(opeaka.eq.'y') then
                       dbs= x23*x23*dbs
                       dbs0= x23*x23*dbs0
                      endif
                      dbs= dbs+coulf*(dabr*dabr+dabre*dabre+
     #                     dabie*dabie+dabi*dabi)
                      if(oqcd.eq.'y'.and.iqcd.eq.0) then
                         dbs= dbs+qcdjac*dbs0*(1.d0+coulf)
                      endif
*
                      if(otype.ne.'cc20') then
                         des= 0.d0
                      else if(otype.eq.'cc20') then
*
*-----helicity e)
*
*-----Bremsstrahlung I: common part
*
                       db1erc= 16.d0*(gn29*(-x13*x24*x56+x13*
     #                         x25*x46+x14*x23*x56-x14*x26*x35-
     #                         x15*x23*x46+x15*x26*x34+x16*x24*
     #                         x35-x16*x25*x34-x23*x25*x46+x25*
     #                         x26*x34-x34*x56+x35*x46)+gn30*
     #                         (x13*x25*x26-x16*x23*x25)+gn31*
     #                         x14*x25s+gn32*(-x13*x24*x25*x56+
     #                         x13*x25s*x46+x14*x23*x25*x56-x14*
     #                         x25*x26*x35+x16*x24*x25*x35-x16*
     #                         x25s*x34+x25*x34*x56-x25*x35*
     #                         x46)+gn33*(x13*x26-x16*x23)+gn34*
     #                         (x14*x25-x15*x24-x24*x25)-gn35*
     #                         x25+gn36)
                       db1eic= 64.d0*(-s2*gn29*x46-s2*gn32*
     #                         x25*x46-s4*gn31*x25-s4*gn34-
     #                         s6*gn29*x34-s6*gn32*x25*x34+
     #                         s8*gn29*x25+s8*gn32*x25s-s12*
     #                         gn29*(x15+x25)+s15*gn29-s15*
     #                         gn32*x25)
*
*-----Bremsstrahlung III: common part
*
                       db3erc= 16.d0*(gn29*(-x13*x24*x56+x13*
     #                         x25*x46+x14*x23*x56-x14*x26*x35-
     #                         x15*x23*x46+x15*x26*x34+x16*x24*
     #                         x35-x16*x25*x34+2.d0*x25*x34*x56-
     #                         2.d0*x25*x35*x46-x34*x56+x35*
     #                         x46)+gn33*(x13*x26-x16*x23)+
     #                         gn34*(-x14*x25+x15*x24)+gn36*
     #                         (-1.d0+2.d0*x25))
                       db3eic= 64.d0*(-s3*gn33+s5*gn29*x35-s6*
     #                         gn29*x34+s7*gn29*x26-s11*gn29*
     #                         x16+s15*gn29*(1.d0-2.d0*x25))
*
*-----Multiperipheral I: common part
*
                       dm1erc= 32.d0*(gn34*(x14*x25-x15*x24)+
     #                        gn36*(1.d0-2.d0*x25))
                       dm1eic= -128.d0*s4*gn34
*
*-----Multiperipheral II: common part
*
                       dm2erc= 32.d0*(gn30*x25*(x13*x46-x16*
     #                         x34)+gn31*x14*x25*x56+gn32*
     #                         x14*x25*(x34*x56-x35*x46)-
     #                         gn34*x25*x46-gn35*x16*x25)
                       dm2eic= 128.d0*x25*(s8*gn30-s10*gn31-
     #                         x14*s15*gn32)
*
*-----Fusion: common part
*
                       dferc= 2.d0*gn29*(x23*x25*x46-x25*x26*
     #                        x34+2.d0*(x25*x34*x56-x25*x35*
     #                        x46))+2.d0*gn30*x25*(-x13*x26-
     #                        2.d0*x13*x46+x16*x23+2.d0*x16*
     #                        x34)-2.d0*gn31*x25*x14*(2.d0*
     #                        x56+x25)
                       dferc= dferc+2.d0*gn32*x25*(x13*x24*
     #                        x56-x13*x25*x46-x14*x23*x56+x14*
     #                        x26*x35-2.d0*x14*x34*x56+2.d0*
     #                        x14*x35*x46-x16*x24*x35+x16*x25*
     #                        x34-x34*x56+x35*x46)+2.d0*gn34*(-
     #                        2.d0*x14*x25+2.d0*x15*x24+x24*
     #                        x25+2.d0*x24*x35+2.d0*(x24*x56-
     #                        x25*x34))+2.d0*gn35*x25*(2.d0*
     #                        x16+1.d0)+4.d0*gn36*(-1.d0-x23+
     #                        x25-x26)
*
                       dfeic= 8.d0*(s2*gn32*x25*x46+s4*gn31*
     #                        x25+2.d0*s4*gn34+s6*gn32*x25*
     #                        x34-2.d0*s7*gn32*x25*x46-s8*gn32*
     #                        x25s+2.d0*s10*gn31*x25+2.d0*s10*
     #                        gn32*x25*x34-2.d0*s11*gn34+s12*gn29*
     #                        x25-2.d0*s14*gn34-2.d0*s15*gn29*x25+
     #                        s15*gn32*x25)
*
*
                       if(ofl.eq.'c'.or.ofl.eq.'a') then
*
      eter4= gv38*(-p36*p54+2*p36*p67-
     #  p36*p71+p49*p50-p49*p64)
      eter4= eter4+gv39*(-p4*p57-p5*x26+p29*
     #  x25s+p29*p51-2*p36*x56+2*p49*x35)
      eter4= eter4+gv40*(-p4*p48-p4*p71+p5
     #  *x46+p8*p48-p13*p55+p13*p72+3*p15
     # *p57-p15*p69-p16*x25-2*p16*x26+3*p
     #  16*x35+p16*x36+p31*p46+p31*p64-p32
     #  *x34-p34*p46-p51*x46+p71*x35-2*u15*x35
     #  -u18*x35+u33-u38)
      eter4= eter4+gv41*(-p5*p48+p5*p54-p5
     #  *p71+p13*p55*x25+p15*p58-p16*p57
     #  +p32*p46-p32*p50+p32*p64+p50*p
     #  55-p50*p72-p51*p54+p51*p71+u6*
     #  p46-u13*p51-u27*p46)
      eter4= eter4+gv43*(-p39*x46+2*p43*x24+p45*
     #  x25+2*p45*x26-p45*x35-p45*x36-2*p46*x26
     #  +p46*x36-2*p50*x25+2*p50*x35+p56*x35-
     #  u28-u29)
      eter4= eter4+gv44*(x25s-2*p3*x56-3*p4*x26+2
     #  *p4*x35+2*p4*x36+p7*x35+p29*x25+p29*
     #  x35+2*p49-3*p51-p52-p69)
*
      eterpmp= gv38*(4*p46*x46-4*p48*x34+2*
     #  p51*x46+2*p67-2*p71-2*u5-2*u13+2*u
     #  18+2*u21-2*u23+2*u26-2*u33+2*u44-
     #  2*u45)
      eterpmp= eterpmp+gv39*(4*u5-4*u26)
      eterpmp= eterpmp+gv41*(4*p15*p67-4*p15*p71)
      eterpmp= eterpmp+gv42*(-2*p7+2*p29-4*p42+4*p56)
      eterpmp= eterpmp+gv43*(2*p15-2*p24-2*p48+2*p54)
      eterpmp= eterpmp+gv45*(2+2*x25+2*x26)
*
      eterppm= gv38*(4*p46*x46-4*p48*x34+2*
     #  p51*x46+2*p67-2*p71-2*u5-2*u13+2*u
     #  18+2*u21-2*u23+2*u26-2*u33+2*u44-2*u45)
      eterppm= eterppm+gv39*(4*u5-4*u26)
      eterppm= eterppm+gv40*(4*u17)
      eterppm= eterppm+gv41*(4*p15*p67-4*p15*p71)
      eterppm= eterppm+gv42*(-2*p7+2*p29-4*p42+4*p56)
      eterppm= eterppm+gv43*(2*p15-2*p24-2*p48-2*p54)
      eterppm= eterppm+gv44*(-4*p31)
      eterppm= eterppm+gv45*(2-6*x25+2*x26)
*
      eterpmm= gv38*(-4*p46*x46+4*p48*x34-2
     #  *p67+2*p71+2*u5+2*u13-2*u18-2*u21
     #  +2*u23-2*u26-2*u44+2*u45)
      eterpmm= eterpmm+gv39*(-4*u5+4*u26)
      eterpmm= eterpmm+gv41*(-4*p15*p67+4*p15*p71)
      eterpmm= eterpmm+gv42*(2*p7-2*p29+4*p42-4*p56)
      eterpmm= eterpmm+gv43*(-2*p15+2*p24)
      eterpmm= eterpmm+gv45*(-2)
*
      eterpp= gv38*(2*p51*x46-2*u33)
      eterpp= eterpp+gv40*(-2*u17)
      eterpp= eterpp+gv43*(2*p48)
      eterpp= eterpp+gv44*(2*p31)
      eterpp= eterpp+gv45*(-2*x25-2*x26)
*
      etermm= gv39*(-2*u5+2*u26)
      etermm= etermm+gv41*(-2*p15*p67+2*p15*p71)
      etermm= etermm+gv43*(2*p15-2*p24)
      etermm= etermm+gv45*(2)
*
      etei4= s4*gv40*(4*x25s+4*p43+8*p49
     #  -8*p51-4*p52-4*p57)
      etei4= etei4+s4*gv41*(-4*p36*x56+4*p49*x35)
      etei4= etei4+s7*gv40*(-4*x25s-4*p43-8*p49
     #  +8*p51+4*p52+4*p57)
      etei4= etei4+s7*gv41*(4*p36*x56-4*p49*x35)
      etei4= etei4+s13*gv38*(-4*p45+4*p50)
      etei4= etei4+s13*gv39*(-4*x25+4*p4)
      etei4= etei4+s13*gv40*(4*p15-4*p18)
      etei4= etei4+s13*gv41*(4*p16-4*u15)
      etei4= etei4+s13*gv43*(-4*x24+4*x34)
      etei4= etei4+s13*gv44*(-4+4*x13)
*
      eteipmp= s2*gv38*(8*x46)
      eteipmp= eteipmp+s4*gv43*(-8)
      eteipmp= eteipmp+s6*gv38*(8*x34)
      eteipmp= eteipmp+s7*gv41*(16*p54)
      eteipmp= eteipmp+s8*gv38*(-8*x25)
      eteipmp= eteipmp+s10*gv41*(-16*p50)
      eteipmp= eteipmp+s11*gv38*(-16*x46)
      eteipmp= eteipmp+s12*gv38*(8*x15)
      eteipmp= eteipmp+s14*gv38*(16*x34)
      eteipmp= eteipmp+s14*gv43*(8)
      eteipmp= eteipmp+s15*gv38*(-8+8*x25)
*
      eteippm= s2*gv38*(8*x46)
      eteippm= eteippm+s4*gv43*(-8)
      eteippm= eteippm+s6*gv38*(8*x34)
      eteippm= eteippm+s7*gv41*(16*p54)
      eteippm= eteippm+s8*gv38*(-8*x25)
      eteippm= eteippm+s10*gv40*(-16*x25)
      eteippm= eteippm+s10*gv41*(-16*p50)
      eteippm= eteippm+s11*gv38*(-16*x46)
      eteippm= eteippm+s12*gv38*(8*x15)
      eteippm= eteippm+s14*gv38*(16*x34)
      eteippm= eteippm+s14*gv43*(8)
      eteippm= eteippm+s15*gv38*(-8+8*x25)
*
      eteipmm= s2*gv38*(-8*x46)
      eteipmm= eteipmm+s4*gv43*(8)
      eteipmm= eteipmm+s6*gv38*(-8*x34)
      eteipmm= eteipmm+s7*gv41*(-16*p54)
      eteipmm= eteipmm+s8*gv38*(8*x25)
      eteipmm= eteipmm+s10*gv41*(16*p50)
      eteipmm= eteipmm+s11*gv38*(16*x46)
      eteipmm= eteipmm+s12*gv38*(-8*x15)
      eteipmm= eteipmm+s14*gv38*(-16*x34)
      eteipmm= eteipmm+s15*gv38*(8)
*
      eteipp= s2*gv39*(2*x56)
      eteipp= eteipp+s3*gv39*(2*x56)
      eteipp= eteipp+s4*gv40*(4*x56)
      eteipp= eteipp+s6*gv39*(2*x35)
      eteipp= eteipp+s6*gv41*(-2*p67+2*p71)
      eteipp= eteipp+s6*gv44*(4)
      eteipp= eteipp+s7*gv41*(-4*p55)
      eteipp= eteipp+s9*gv39*(-6*x25)
      eteipp= eteipp+s9*gv41*(2*p48-2*p54)
      eteipp= eteipp+s10*gv40*(4*x25)
      eteipp= eteipp+s10*gv41*(4*p51)
      eteipp= eteipp+s11*gv38*(-2*x56)
      eteipp= eteipp+s12*gv38*(-2*x56)
      eteipp= eteipp+s13*gv38*(2*x46)
      eteipp= eteipp+s13*gv39*(-2*x16)
      eteipp= eteipp+s14*gv38*(2*x35)
      eteipp= eteipp+s14*gv41*(-2*p11+2*p34)
      eteipp= eteipp+s14*gv43*(-4)
      eteipp= eteipp+s15*gv38*(2*x25)
      eteipp= eteipp+s15*gv41*(2*x56-2*p31)
*
      eteimm= s2*gv38*(2*x46)
      eteimm= eteimm+s2*gv39*(-2*x46)
      eteimm= eteimm+s2*gv41*(-2*p22)
      eteimm= eteimm+s3*gv39*(2*x45)
      eteimm= eteimm+s3*gv42*(-2)
      eteimm= eteimm+s4*gv43*(-8)
      eteimm= eteimm+s6*gv38*(2*x34)
      eteimm= eteimm+s6*gv39*(-2*x34)
      eteimm= eteimm+s6*gv41*(-2*p18)
      eteimm= eteimm+s7*gv41*(4*p31-4*p54)
      eteimm= eteimm+s8*gv38*(-4*x25)
      eteimm= eteimm+s8*gv39*(-4*x25)
      eteimm= eteimm+s9*gv38*(-2*x24)
      eteimm= eteimm+s9*gv39*(2*x24)
      eteimm= eteimm+s9*gv41*(6*p15)
      eteimm= eteimm+s10*gv41*(-4*p4+4*p50)
      eteimm= eteimm+s11*gv38*(-2*x16)
      eteimm= eteimm+s11*gv39*(2*x16)
      eteimm= eteimm+s11*gv41*(-2*p22)
      eteimm= eteimm+s12*gv38*(2*x15)
      eteimm= eteimm+s12*gv42*(-2)
      eteimm= eteimm+s13*gv38*(-2*x14)
      eteimm= eteimm+s13*gv39*(-2*x14)
      eteimm= eteimm+s14*gv38*(2*x13)
      eteimm= eteimm+s14*gv39*(-2*x13)
      eteimm= eteimm+s14*gv41*(2*p18)
      eteimm= eteimm+s15*gv38*(-2)
      eteimm= eteimm+s15*gv39*(2)
      eteimm= eteimm+s15*gv41*(2*p15)
* 
      if(ofl.eq.'c') then
       dfevr= -(ecv4er*eter4+(ecv1er-ecv2er+ecv3er)*eterpmp+
     #         (ecv1er+ecv2er-ecv3er)*eterppm+
     #         (ecv1er-ecv2er-ecv3er)*eterpmm+(ecv5er+ecv6er)*
     #         eterpp+(ecv5er-ecv6er)*etermm)/32.d0/pis
       dfevie= -(ecv4er*etei4+(ecv1er-ecv2er+ecv3er)*eteipmp+
     #          (ecv1er+ecv2er-ecv3er)*eteippm+
     #          (ecv1er-ecv2er-ecv3er)*eteipmm+(ecv5er+ecv6er)*
     #          eteipp+(ecv5er-ecv6er)*eteimm)/32.d0/pis
       dfevi= -(ecv4ei*eter4+(ecv1ei-ecv2ei+ecv3ei)*eterpmp+
     #         (ecv1ei+ecv2ei-ecv3ei)*eterppm+
     #         (ecv1ei-ecv2ei-ecv3ei)*eterpmm+(ecv5ei+ecv6ei)*
     #         eterpp+(ecv5ei-ecv6ei)*etermm)/32.d0/pis
       dfevre= (ecv4ei*etei4+(ecv1ei-ecv2ei+ecv3ei)*eteipmp+
     #         (ecv1ei+ecv2ei-ecv3ei)*eteippm+
     #         (ecv1ei-ecv2ei-ecv3ei)*eteipmm+(ecv5ei+ecv6ei)*
     #         eteipp+(ecv5ei-ecv6ei)*eteimm)/32.d0/pis
      else if(ofl.eq.'a') then
       dfevr= (ecv4er*eter4+(ecv1er-ecv2er+ecv3er)*eterpmp+
     #        (ecv1er+ecv2er-ecv3er)*eterppm+
     #        (ecv1er-ecv2er-ecv3er)*eterpmm+(ecv5er+ecv6er)*
     #        eterpp+(ecv5er-ecv6er)*etermm)*4.d0
       dfevie= (ecv4er*etei4+(ecv1er-ecv2er+ecv3er)*eteipmp+
     #         (ecv1er+ecv2er-ecv3er)*eteippm+
     #         (ecv1er-ecv2er-ecv3er)*eteipmm+(ecv5er+ecv6er)*
     #         eteipp+(ecv5er-ecv6er)*eteimm)*4.d0
       dfevi= (ecv4ei*eter4+(ecv1ei-ecv2ei+ecv3ei)*eterpmp+
     #        (ecv1ei+ecv2ei-ecv3ei)*eterppm+
     #        (ecv1ei-ecv2ei-ecv3ei)*eterpmm+(ecv5ei+ecv6ei)*
     #        eterpp+(ecv5ei-ecv6ei)*etermm)*4.d0
       dfevre= -(ecv4ei*etei4+(ecv1ei-ecv2ei+ecv3ei)*eteipmp+
     #          (ecv1ei+ecv2ei-ecv3ei)*eteippm+
     #          (ecv1ei-ecv2ei-ecv3ei)*eteipmm+(ecv5ei+ecv6ei)*
     #          eteipp+(ecv5ei-ecv6ei)*eteimm)*4.d0
      endif
*
                       endif

*
                       endif
*
                       if(ofl.eq.'y') then
                        dfegirc=                                              
     #                           gi16*(x56i*c4*p49*p71+c1*(-2.d0*p51*
     #                           x46+u28-u29+2.d0*u33)+(-u28+u29)*(c2+
     #                           c3)-0.5d0*c4*(u28+u29))
                        dfegirc= dfegirc+
     #                           gi17*w1*(cpmm-0.5d0*c4)
                        dfegirc= dfegirc+
     #                           gi18*((c1-c2)*(w2-2.d0*u17)+c3*(-w2-
     #                           2.d0*u17)+0.5d0*c4*(-w2+p67-p71+u5-
     #                           u13-2.d0*u14+u16+u18-u26-u44+u45))
                        dfegirc= dfegirc+
     #                           gi19*(cpmm-0.5d0*c4)*(p4*p48-p5*x46-
     #                           p13*p55+p15*p57-p31*p46+p32*x34+p51*
     #                           x46-u33)
                        dfegirc= dfegirc+
     #                           gi20*c4*(x56i*p49*x35-p36)
                        dfegirc= dfegirc+
     #                           gi21*(x56i*c4*x46*(p49-p51-p52)+c1*(-
     #                           p45+2.d0*(p46+p48))+c2*(p45-2.d0*(p46+
     #                           p54))+c3*(p45-2.d0*(p46-p54))+0.5d0*
     #                           c4*(p42+p45+p47-p56))
                        dfegirc= dfegirc+
     #                           gi22*(x56i*c4*(p31*x26+p32-p34*x26-
     #                           u27)+(c1-c2)*(-x25+2.d0*p4+2.d0*p31)+
     #                           c3*(x25-2.d0*p4+2.d0*p31)+0.5d0*c4*(-
     #                           x25-x36+p7+p29))
                        dfegirc= dfegirc+
     #                           gi23*(x56i*c4*(x25s+2.d0*(p49-p51)-
     #                           p52-p57)+2.d0*c1*(-x23+x25-x26)+2.d0*
     #                           c2*(x23-2.d0*x25)+2.d0*c3*(x23+2.d0*
     #                           x25)+c4*x23)
*
                        dfegiic=
     #                           4.d0*(p54*s2*gi19-x25*s4*gi18+p50*s6*
     #                           gi19+2.d0*x25*s7*gi18-x25s*s8*gi19)*
     #                           cpmm
                        dfegiic= dfegiic+
     #                           2.d0*s10*gi18*(x56i*c4*(x25s+2.d0*(
     #                           p49-p51)-p52-p57)+4.d0*x25*cpmp+c4*x23)
                        dfegiic= dfegiic+
     #                           2.d0*s10*gi19*c4*(x56i*p49*x35-p36)
                        dfegiic= dfegiic-
     #                           8.d0*s11*gi21*cpmm
                        dfegiic= dfegiic+
     #                           4.d0*x25*s12*gi16*cpmm
                        dfegiic= dfegiic+
     #                           2.d0*s13*c4*x56i*(-gi16*p54-gi17*p31-
     #                           2.d0*gi20*x25-gi21*x46-gi22*x16-2.d0*
     #                           gi23)
                        dfegiic= dfegiic+
     #                           2.d0*s13*c4*(gi18*x14+gi19*p15)
                        dfegiic= dfegiic-
     #                           8.d0*s14*gi21*c1
                        dfegiic= dfegiic+
     #                           4.d0*x25*s15*(-2.d0*gi16*c1+gi19*cpmm)
                       else if(ofl.eq.'n'.or.ofl.eq.'e') then
                        dfegirc= 0.d0
                        dfegiic= 0.d0
                       endif
* 
                       db1er=  -3.125d-2/pfb*cob1e*db1erc
                       db1eie= -3.125d-2/pfb*cob1e*db1eic
                       if(ofl.eq.'c') then
                        db3er= x23*ver23/128.d0/ctr23/pn*pp23r*
     #                         db3erc
                        db3eie= x23*ver23/128.d0/ctr23/pn*pp23r*
     #                          db3eic
                       else
                        db3er= x23*ver/128.d0/cth2/pn/x23z*db3erc
                        db3eie= x23*ver/128.d0/cth2/pn/x23z*db3eic
                       endif
                       dber= db1er+db3er
                       dbeie= db1eie+db3eie
                       dbere= 0.d0
                       dbei= 0.d0
                       if(ofl.eq.'c') then
                        dm1er=  3.125d-2*pp14r/pm23*com1e*dm1erc
                        dm1eie= 3.125d-2*pp14r/pm23*com1e*dm1eic
                        dm2er=  3.125d-2*pp14r/pm24*com2e*dm2erc
                        dm2eie= 3.125d-2*pp14r/pm24*com2e*dm2eic
                        dm1ei= 0.d0
                        dm1ere= 0.d0
                        dm2ei= 0.d0
                        dm2ere= 0.d0
                       else
                        if(oww.eq.'r') then
                         dm1er=  3.125d-2/pp14/pm23*com1e*dm1erc
                         dm1eie= 3.125d-2/pp14/pm23*com1e*dm1eic
                         dm2er=  3.125d-2/pp14/pm24*com2e*dm2erc
                         dm2eie= 3.125d-2/pp14/pm24*com2e*dm2eic
                         dm1ei= 0.d0
                         dm1ere= 0.d0
                         dm2ei= 0.d0
                         dm2ere= 0.d0
                        else if(oww.eq.'f'.or.oww.eq.'i') then
                         dm1er=  3.125d-2*pp14r/pm23*com1e*dm1erc
                         dm1eie= 3.125d-2*pp14r/pm23*com1e*dm1eic
                         dm2er=  3.125d-2*pp14r/pm24*com2e*dm2erc
                         dm2eie= 3.125d-2*pp14r/pm24*com2e*dm2eic
                         dm1ei=  3.125d-2*pp14i/pm23*com1e*dm1erc
                         dm1ere= -3.125d-2*pp14i/pm23*com1e*dm1eic
                         dm2ei=  3.125d-2*pp14i/pm24*com2e*dm2erc
                         dm2ere= -3.125d-2*pp14i/pm24*com2e*dm2eic
                        endif
                       endif
                       dmer= dm1er+dm2er
                       dmeie= dm1eie+dm2eie
                       dmei= dm1ei+dm2ei
                       dmere= dm1ere+dm2ere
                       if(ofl.eq.'c') then
                          dfer= 1.25d-1*(pp14rb*cofce*dferc-
     #                          0.5d0*g2*pp14r*dfevr)
                          dfeie= 1.25d-1*(pp14rb*cofce*dfeic-
     #                          0.5d0*g2*pp14r*dfevie)
                          dfere= -6.25d-2*pp14r*g2*dfevre
                          dfei= -6.25d-2*pp14r*g2*dfevi
                       else if(ofl.eq.'a') then
                        if(oww.eq.'r') then
                           dfer=  1.25d-1/pp14*(cofce*dferc-
     #                            0.5d0*dfevr)
                           dfeie= 1.25d-1/pp14*(cofce*dfeic-
     #                            0.5d0*dfevie)
                           dfere= -6.25d-2/pp14*dfevre
                           dfei= -6.25d-2/pp14*dfevi
                        else if(oww.eq.'f'.or.oww.eq.'i') then
                           dfer= 1.25d-1*pp14r*(cofce*dferc-
     #                            0.5d0*dfevr)
                           dfeie= 1.25d-1*pp14r*(cofce*dfeic-
     #                            0.5d0*dfevie)
                           dfere= -1.25d-1*pp14i*cofce*dfeic-
     #                            6.25d-2*pp14r*dfevre
                           dfei= 1.25d-1*pp14i*cofce*dferc-
     #                           6.25d-2*pp14r*dfevi
                        endif
                       else
                        if(oww.eq.'r') then
                           dfer=  1.25d-1/pp14*cofce*dferc
                           dfeie= 1.25d-1/pp14*cofce*dfeic
                        else if(oww.eq.'f'.or.oww.eq.'i') then
                           dfer=  1.25d-1*pp14r*cofce*dferc
                           dfeie= 1.25d-1*pp14r*cofce*dfeic
                        endif
                       endif
                       if(ofl.eq.'y') then
                          dfei= 6.25d-2/pp14*cofce*gifact*dfegirc
                          dfere= -6.25d-2/pp14*cofce*gifact*dfegiic
                       else if(ofl.eq.'e') then
                          gfct= swg*x56/(x56+x14)
                          dfei= 1.25d-1/pp14*cofce*gfct*dferc
                          dfere= -1.25d-1/pp14*cofce*gfct*dfeic
                       else if(ofl.eq.'n') then
                          if(oww.eq.'f'.or.oww.eq.'i') then
                             dfei=  1.25d-1*pp14i*cofce*dferc
                             dfere= -1.25d-1*pp14i*cofce*dfeic
                          else
                             dfei= 0.d0
                             dfere= 0.d0
                          endif
                       endif
*
                       d20esrr= dber+dfer
                       d20esrie= dbeie+dfeie
                       d20esri= dbei+dfei
                       d20esrre= dbere+dfere
                       if(ofl.eq.'c') then
                        d20er= (d20esrr*flpr-d20esri*flpi)/g2+
     #                         wpcfr*dmer-wpcfi*dmei
                        d20ere= (d20esrre*flpr-d20esrie*flpi)/g2-
     #                          wpcfi*dmeie+wpcfr*dmere
                        d20eie= (d20esrre*flpi+d20esrie*flpr)/g2+
     #                          wpcfr*dmeie+wpcfi*dmere
                        d20ei= (d20esri*flpr+d20esrr*flpi)/g2+
     #                         wpcfi*dmer+wpcfr*dmei 
                       else
                        d20er= d20esrr+wpcfr*dmer-wpcfi*dmei
                        d20ere= d20esrre-wpcfi*dmeie+wpcfr*dmere
                        d20eie= d20esrie+wpcfr*dmeie+wpcfi*dmere
                        d20ei= d20esri+wpcfi*dmer+wpcfr*dmei 
                       endif
*
                       cd20er= wmcfr*d20er-wmcfi*d20ei
                       cd20ere= wmcfr*d20ere-wmcfi*d20eie
                       cd20eie= wmcfr*d20eie+wmcfi*d20ere
                       cd20ei= wmcfr*d20ei+wmcfi*d20er
*
                       des= cd20er*cd20er+cd20ere*cd20ere+
     #                      cd20eie*cd20eie+cd20ei*cd20ei
                       if(opeaka.eq.'n'.or.opeaka.eq.'f') then
                        des= des/x23/x23
                       endif
*                      endif
*
    4                if(iz.eq.0) then
                        dpxs(ix,it,itt,1)= 0.d0
                        dpxs(ix,it,itt,2)= 0.d0
                        dpxs(ix,it,itt,3)= 0.d0
                        iz= 1
                        isz= 0
                     else 
                        isz= 1
                        tjac= ujc*vjc*smjc*spjc*sujc*sdjc*
     #                        sfjc*twjc*t1jc*vv*ajc*fov
                        if(oqcd.eq.'y'.and.iqcd.gt.0) then
                           tjacp= tjac*pmjac*ppjac*(1.d0+qcdjac)*stf/s
                        else
                           tjacp= tjac*pmjac*ppjac*stf/s
                        endif
                        if(ockm.eq.'y') then
                         if(ipr.eq.2.or.ipr.eq.5) then
                           if(ickm.eq.1) then 
                              tjacp= tjacp*vckm(1,1)*vckm(1,1)
                           else if(ickm.eq.2) then
                              tjacp= tjacp*vckm(1,2)*vckm(1,2)
                           else if(ickm.eq.3) then
                              tjacp= tjacp*vckm(1,3)*vckm(1,3)
                           else if(ickm.eq.4) then
                              tjacp= tjacp*vckm(2,1)*vckm(2,1)
                           else if(ickm.eq.5) then
                              tjacp= tjacp*vckm(2,2)*vckm(2,2)
                           else if(ickm.eq.6) then
                              tjacp= tjacp*vckm(2,3)*vckm(2,3) 
                           endif
                         else if(ipr.eq.3) then
                           if(ickm.eq.1) then 
                              tjacp= tjacp*vckm(1,1)*vckm(1,1)*
     #                               vckm(2,2)*vckm(2,2)
                           else if(ickm.eq.2) then
                              tjacp= tjacp*vckm(1,1)*vckm(1,1)*
     #                               vckm(2,1)*vckm(2,1)
                           else if(ickm.eq.3) then
                              tjacp= tjacp*vckm(1,1)*vckm(1,1)*
     #                               vckm(2,3)*vckm(2,3)
                           else if(ickm.eq.4) then
                              tjacp= tjacp*vckm(1,2)*vckm(1,2)*
     #                               vckm(2,2)*vckm(2,2)
                           else if(ickm.eq.5) then
                              tjacp= tjacp*vckm(1,2)*vckm(1,2)*
     #                               vckm(2,1)*vckm(2,1)
                           else if(ickm.eq.6) then
                              tjacp= tjacp*vckm(1,2)*vckm(1,2)*
     #                               vckm(2,3)*vckm(2,3)
                           else if(ickm.eq.7) then
                              tjacp= tjacp*vckm(1,3)*vckm(1,3)*
     #                               vckm(2,2)*vckm(2,2)
                           else if(ickm.eq.8) then
                              tjacp= tjacp*vckm(1,3)*vckm(1,3)*
     #                               vckm(2,1)*vckm(2,1)
                           else if(ickm.eq.9) then
                              tjacp= tjacp*vckm(1,3)*vckm(1,3)*
     #                               vckm(2,3)*vckm(2,3)
                           else if(ickm.eq.10) then
                              tjacp= tjacp*vckm(1,1)*vckm(1,1)*
     #                               vckm(1,2)*vckm(1,2)
                           else if(ickm.eq.11) then
                              tjacp= tjacp*vckm(1,1)*vckm(1,1)*
     #                               vckm(1,3)*vckm(1,3)
                           else if(ickm.eq.12) then
                              tjacp= tjacp*vckm(1,2)*vckm(1,2)*
     #                               vckm(1,3)*vckm(1,3)
                           else if(ickm.eq.13) then
                              tjacp= tjacp*vckm(2,1)*vckm(2,1)*
     #                               vckm(2,2)*vckm(2,2)
                           else if(ickm.eq.14) then 
                              tjacp= tjacp*vckm(2,1)*vckm(2,1)*
     #                               vckm(2,3)*vckm(2,3)
                           else if(ickm.eq.15) then
                              tjacp= tjacp*vckm(2,2)*vckm(2,2)*
     #                               vckm(2,3)*vckm(2,3) 
                           endif
                         endif
                        endif
                        dpxs(ix,it,itt,1)= tjacp*das
                        dpxs(ix,it,itt,2)= tjacp*dbs
                        if(otype.eq.'cc20') then
                           dpxs(ix,it,itt,3)= tjacp*des
                        else
                           dpxs(ix,it,itt,3)= 0.d0
                        endif 
                     endif
*
*-----Final state QD radiation is includedp
*
               if(isz.eq.1.and.ofsr.eq.'y') then
                  efsr1(ix,it)= edn1
                  efsr2(ix,it)= edn2
                  efsr3(ix,it)= edn3
                  efsr4(ix,it)= edn4
               else
                  efsr1(ix,it)= 0.d0
                  efsr2(ix,it)= 0.d0
                  efsr3(ix,it)= 0.d0
                  efsr4(ix,it)= 0.d0
               endif
*
             if(isz.eq.1.and.ofsr.eq.'y') then
                if(ipr.eq.1) then
                   xv1= 2.d0*ae(1)/rs/efsr1(ix,it)
                   xv2= 0.d0
                   xv3= 0.d0
                   xv4= 2.d0*ae(4)/rs/efsr4(ix,it)
                else if(ipr.eq.2) then
                   xv1= 2.d0*ae(1)/rs/efsr1(ix,it)
                   xv2= 0.d0
                   xv3= 2.d0*ae(3)/rs/efsr3(ix,it)
                   xv4= 2.d0*ae(4)/rs/efsr4(ix,it)
                else if(ipr.eq.3) then
                   xv1= 2.d0*ae(1)/rs/efsr1(ix,it)
                   xv2= 2.d0*ae(2)/rs/efsr2(ix,it)
                   xv3= 2.d0*ae(3)/rs/efsr3(ix,it)
                   xv4= 2.d0*ae(4)/rs/efsr4(ix,it)
                endif
                if(xv1.ge.1.d0.or.xv2.ge.1.d0.or.
     #             xv3.ge.1.d0.or.xv4.ge.1.d0) then
                   fsr(ix,it)= 1.d0
                else
                   rcom= delc*pi/180.d0
                   if(ipr.eq.1) then
                      rmu= 0.5d0*rcom*efsr1(ix,it)/rmm
                      rtau= 0.5d0*rcom*efsr4(ix,it)/tm
                      rmu0= efsr1(ix,it)/rmm
                      rtau0= efsr4(ix,it)/tm
                   else if(ipr.eq.2) then 
                      rmu= 0.5d0*rcom*efsr1(ix,it)/rmm
                      ruq= 0.5d0*rcom*efsr3(ix,it)/uqm
                      rdq= 0.5d0*rcom*efsr4(ix,it)/dqm
                      rmu0= efsr1(ix,it)/rmm
                      ruq0= efsr3(ix,it)/uqm
                      rdq0= efsr4(ix,it)/dqm
                   else if(ipr.eq.3) then 
                      ruq= 0.5d0*rcom*efsr1(ix,it)/uqm
                      rdq= 0.5d0*rcom*efsr2(ix,it)/dqm
                      rsq= 0.5d0*rcom*efsr3(ix,it)/sqm
                      rcq= 0.5d0*rcom*efsr4(ix,it)/cqm
                      ruq0= efsr1(ix,it)/uqm
                      rdq0= efsr2(ix,it)/dqm
                      rsq0= efsr3(ix,it)/sqm
                      rcq0= efsr4(ix,it)/cqm
                   endif
                   if(ipr.eq.1) then
                      omxv1= 1.d0-xv1
                      omxv4= 1.d0-xv4
                      rsp1= wtorfsr(xv1,rmu)
                      rsp4= wtorfsr(xv4,rtau)
                      rlno1= log(omxv1)
                      rlno4= log(omxv4) 
                      rln1= log(xv1)
                      rln4= log(xv4)
                      aln1= log(1.d0+rmu*rmu*xv1*xv1)
                      aln4= log(1.d0+rtau*rtau*xv4*xv4)
                      rmus= rmu*rmu 
                      ormus= 1.d0+rmus
                      rxmu= rmu*xv1 
                      rtaus= rtau*rtau
                      ortaus= 1.d0+rtaus
                      rxtau= rtau*xv4 
                      fsrmu= -rlno1*(aln1-rmus/ormus)+(0.25d0*
     #                       (ormus*ormus-2.d0)/rmus/ormus- 
     #                       (1.d0-0.5d0*omxv1)**2)*aln1-(2.d0+
     #                       rmus)/rmu/ormus*atan(rxmu)+9.d0/4.d0-
     #                       5.d0/2.d0*omxv1+0.25d0*omxv1*omxv1+rsp1
                      fsrtau= -rlno4*(aln4-rtaus/ortaus)+(0.25d0*
     #                        (ortaus*ortaus-2.d0)/rtaus/ortaus-
     #                        (1.d0-0.5d0*omxv4)**2)*aln4-(2.d0+
     #                        rtaus)/rtau/ortaus*atan(rxtau)+9.d0/
     #                        4.d0-5.d0/2.d0*omxv4+0.25d0*omxv4*
     #                        omxv4+rsp4
                      soft= -rlno1*(1.d0-2.d0*log(rmu0))- 
     #                      rlno4*(1.d0-2.d0*log(rtau0))
                      hard= fsrmu+fsrtau
                      fsr(ix,it)= exp(alpha/pi*soft)*(1.d0+alpha/pi*
     #                            hard)
                   else if(ipr.eq.2) then
                      omxv1= 1.d0-xv1
                      omxv3= 1.d0-xv3 
                      omxv4= 1.d0-xv4
                      rsp1= wtorfsr(xv1,rmu)
                      rsp3= wtorfsr(xv3,ruq)
                      rsp4= wtorfsr(xv4,rdq)
                      rlno1= log(omxv1)
                      rlno3= log(omxv3)
                      rlno4= log(omxv4)
                      rln1= log(xv1)
                      rln3= log(xv3)
                      rln4= log(xv4)
                      aln1= log(1.d0+rmu*rmu*xv1*xv1)
                      aln3= log(1.d0+ruq*ruq*xv3*xv3)
                      aln4= log(1.d0+rdq*rdq*xv4*xv4)
                      rmus= rmu*rmu 
                      ormus= 1.d0+rmus
                      rxmu= rmu*xv1
                      ruqs= ruq*ruq
                      oruqs= 1.d0+ruqs
                      rxuq= ruq*xv3
                      rdqs= rdq*rdq
                      ordqs= 1.d0+rdqs
                      rxdq= rdq*xv4 
                      fsrmu= -rlno1*(aln1-rmus/ormus)+(0.25d0*
     #                       (ormus*ormus-2.d0)/rmus/ormus-
     #                       (1.d0-0.5d0*omxv1)**2)*aln1-(2.d0+
     #                       rmus)/rmu/ormus*atan(rxmu)+9.d0/4.d0-
     #                       5.d0/2.d0*omxv1+0.25d0*omxv1*omxv1+rsp1
                      fsruq= -rlno3*(aln3-ruqs/oruqs)+(0.25d0*
     #                       (oruqs*oruqs-2.d0)/ruqs/oruqs- 
     #                       (1.d0-0.5d0*omxv3)**2)*aln3-(2.d0+
     #                       ruqs)/ruq/oruqs*atan(rxuq)+9.d0/4.d0-
     #                       5.d0/2.d0*omxv3+0.25d0*omxv3*omxv3+rsp3
                      fsrdq= -rlno4*(aln4-rdqs/ordqs)+(0.25d0*
     #                       (ordqs*ordqs-2.d0)/rdqs/ordqs-
     #                       (1.d0-0.5d0*omxv4)**2)*aln4-(2.d0+
     #                       rdqs)/rdq/ordqs*atan(rxdq)+9.d0/4.d0-
     #                       5.d0/2.d0*omxv4+0.25d0*omxv4*omxv4+rsp4
                      soft= -rlno1*(1.d0-2.d0*log(rmu0))-4.d0/9.d0*
     #                      rlno3*(1.d0-2.d0*log(ruq0))-1.d0/9.d0*
     #                      rlno4*(1.d0-2.d0*log(rdq0))
                      hard= fsrmu+4.d0/9.d0*fsruq+1.d0/9.d0*fsrdq
                      fsr(ix,it)= exp(alpha/pi*soft)*(1.d0+alpha/pi*
     #                         hard)
                   else if(ipr.eq.3) then
                      omxv1= 1.d0-xv1
                      omxv2= 1.d0-xv2 
                      omxv3= 1.d0-xv3
                      omxv4= 1.d0-xv4
                      rsp1= wtorfsr(xv1,ruq)
                      rsp2= wtorfsr(xv2,rdq)
                      rsp3= wtorfsr(xv3,rsq)
                      rsp4= wtorfsr(xv4,rcq)
                      rlno1= log(omxv1)
                      rlno2= log(omxv2)
                      rlno3= log(omxv3)
                      rlno4= log(omxv4)
                      rln1= log(xv1)
                      rln2= log(xv2)
                      rln3= log(xv3)
                      rln4= log(xv4)
                      aln1= log(1.d0+ruq*ruq*xv1*xv1)
                      aln2= log(1.d0+rdq*rdq*xv2*xv2)
                      aln3= log(1.d0+rsq*rsq*xv3*xv3)
                      aln4= log(1.d0+rcq*rcq*xv4*xv4)
                      ruqs= ruq*ruq
                      oruqs= 1.d0+ruqs
                      rxuq= ruq*xv1
                      rdqs= rdq*rdq
                      ordqs= 1.d0+rdqs
                      rxdq= rdq*xv2
                      rsqs= rsq*rsq
                      orsqs= 1.d0+rsqs
                      rxsq= rsq*xv3
                      rcqs= rcq*rcq
                      orcqs= 1.d0+rcqs
                      rxcq= rcq*xv4 
                      fsruq= -rlno1*(aln1-ruqs/oruqs)+(0.25d0*
     #                       (oruqs*oruqs-2.d0)/ruqs/oruqs-
     #                       (1.d0-0.5d0*omxv1)**2)*aln1-(2.d0+
     #                       ruqs)/ruq/oruqs*atan(rxuq)+9.d0/4.d0-
     #                       5.d0/2.d0*omxv1+0.25d0*omxv1*omxv1+rsp1
                      fsrdq= -rlno2*(aln2-rdqs/ordqs)+(0.25d0*
     #                       (ordqs*ordqs-2.d0)/rdqs/ordqs-
     #                       (1.d0-0.5d0*omxv2)**2)*aln2-(2.d0+
     #                       rdqs)/rdq/ordqs*atan(rxdq)+9.d0/4.d0-
     #                       5.d0/2.d0*omxv2+0.25d0*omxv2*omxv2+rsp2
                      fsrsq= -rlno3*(aln3-rsqs/orsqs)+(0.25d0*
     #                       (orsqs*orsqs-2.d0)/rsqs/orsqs-
     #                       (1.d0-0.5d0*omxv3)**2)*aln3-(2.d0+
     #                       rsqs)/rsq/orsqs*atan(rxsq)+9.d0/4.d0-
     #                       5.d0/2.d0*omxv3+0.25d0*omxv3*omxv3+rsp3
                      fsrcq= -rlno4*(aln4-rcqs/orcqs)+(0.25d0*
     #                       (orcqs*orcqs-2.d0)/rcqs/orcqs-
     #                       (1.d0-0.5d0*omxv4)**2)*aln4-(2.d0+
     #                       rcqs)/rcq/orcqs*atan(rxcq)+9.d0/4.d0-
     #                       5.d0/2.d0*omxv4+0.25d0*omxv4*omxv4+rsp4
                      soft= -4.d0/9.d0*(rlno1*(1.d0-2.d0*log(ruq0))+
     #                      rlno4*(1.d0-2.d0*log(rcq0)))-1.d0/9.d0*(
     #                      rlno2*(1.d0-2.d0*log(rdq0))+
     #                      rlno4*(1.d0-2.d0*log(rsq0)))
                      hard= 4.d0/9.d0*(fsruq+fsrcq)+1.d0/9.d0*
     #                      (fsrdq+fsrsq)
                      fsr(ix,it)= exp(alpha/pi*soft)*(1.d0+alpha/pi*
     #                         hard)
                   endif
                endif
             else
                fsr(ix,it)= 1.d0
             endif
             do il=1,3
                  dpxs(ix,it,itt,il)= dpxs(ix,it,itt,il)*fsr(ix,it)
             enddo
*
*-----end of ix loop
*                     
                 enddo
*
    5            if(iz.eq.0) then
                    do i=1,3
                        do ix=1,2
                             epxs(ix,it,itt,i)= 0.d0
                        enddo
                    enddo
                    iz= 1
                 else
                    do i=1,3
                        do ix=1,2
                             epxs(ix,it,itt,i)= dpxs(ix,it,itt,i)
                        enddo
                    enddo
                 endif
*
*-----end of itt loop
*                     
                 enddo
*
                 do i=1,3
                     cpxs(it,i)= 0.d0
                     do itt=1,ittm
                       cpxs(it,i)= cpxs(it,i)+epxs(1,it,itt,i)+
     #                             epxs(2,it,itt,i)
                     enddo
                 enddo
*
    2          if(iz.eq.0) then
                  bpxs(it,1)= 0.d0
                  bpxs(it,2)= 0.d0
                  bpxs(it,3)= 0.d0
                  iz= 1
               else
                  bpxs(it,1)= cpxs(it,1)
                  bpxs(it,2)= cpxs(it,2)
                  bpxs(it,3)= cpxs(it,3)
               endif
               if(itc.eq.2.or.itc.eq.3) then
                  do ie=1,4
                       emu(ie,it)= edn1**ie
                  enddo
               endif
               if(itc.eq.3) then
                  ctmu(it)= 1.d0-2.d0*xm*t1/emu(1,it)
                  ctmu2(it)= ctmu(it)*ctmu(it)
                  t1mu(it)= ctmu(it)
                  t2mu(it)= 2.d0*ctmu2(it)-1.d0
                  t3mu(it)= ctmu(it)*(4.d0*ctmu2(it)-3.d0)
                  t4mu(it)= 8.d0*ctmu2(it)*(ctmu2(it)-1.d0)+
     #                      1.d0
               endif     
*
*-----end on it loop
*
          enddo
*
    1     if(iz.eq.0) then
             apxs(1)= 0.d0
             apxs(2)= 0.d0
             apxs(3)= 0.d0
             if(itc.eq.2) then
                do ie=1,4
                     emut(ie)= 0.d0
                enddo
             endif
             if(itc.eq.3) then
                xt1mu= 0.d0
                xt2mu= 0.d0
                xt3mu= 0.d0
                xt4mu= 0.d0
             endif
             iz= 1
          else
             apxs(1)= bpxs(1,1)+bpxs(2,1)
             apxs(2)= bpxs(1,2)+bpxs(2,2)
             apxs(3)= bpxs(1,3)+bpxs(2,3)
             if(itc.eq.2) then
                do ie=1,4
                     emut(ie)= (bpxs(1,1)+bpxs(1,2)+bpxs(1,3))*
     #                          emu(ie,1)+(bpxs(2,1)+bpxs(2,2)+
     #                          bpxs(2,3))*emu(ie,2)
                enddo
             endif
             if(itc.eq.3) then
                xt1mu= (bpxs(1,1)+bpxs(1,2)+bpxs(1,3))*t1mu(1)+
     #                 (bpxs(2,1)+bpxs(2,2)+bpxs(2,3))*t1mu(2)
                xt2mu= (bpxs(1,1)+bpxs(1,2)+bpxs(1,3))*t2mu(1)+
     #                 (bpxs(2,1)+bpxs(2,2)+bpxs(2,3))*t2mu(2)
                xt3mu= (bpxs(1,1)+bpxs(1,2)+bpxs(1,3))*t3mu(1)+
     #                 (bpxs(2,1)+bpxs(2,2)+bpxs(2,3))*t3mu(2)
                xt4mu= (bpxs(1,1)+bpxs(1,2)+bpxs(1,3))*t4mu(1)+
     #                 (bpxs(2,1)+bpxs(2,2)+bpxs(2,3))*t4mu(2)
             endif
          endif
*
      if((apxs(1)+apxs(2)+apxs(3)).lt.0.d0) then
         ifz(51)= ifz(51)+1
         resf= 0.d0
      else
         resf= apxs(1)+apxs(2)+apxs(3)
      endif
*
      if(itc.le.1) then
         wtoxsc= tfact*resf
         if(om.eq.'g') then
            if(osm.eq.'n') then
               jp= iwtopos(ndim,x)
               if(otype.eq.'cc12') then
                  if(wtoxsc.gt.xshmx(jp)) then
                     xshmx(jp)= wtoxsc
                     do l=1,9
                         xmxh(jp,l)= x(l)
                     enddo
                  endif
               else
                  if(wtoxsc.gt.xscmx(jp)) then
                     xscmx(jp)= wtoxsc
                     do l=1,9
                         xmx(jp,l)= x(l)
                     enddo
                  endif
               endif
            endif
            if(otype.eq.'cc12') then
               xaph(1)= xm
               xaph(2)= xp
               xaph(3)= sm
               xaph(4)= sp
               xaph(5)= su
               xaph(6)= sd
               xaph(7)= sf
               xaph(8)= tw
               xaph(9)= t1
               xaph(10)= t3
            else
               xap(1)= xm
               xap(2)= xp
               xap(3)= sm
               xap(4)= sp
               xap(5)= su
               xap(6)= sd
               xap(7)= sf
               xap(8)= tw
               xap(9)= t1
               xap(10)= t3
            endif
         endif
      else if(itc.ge.7) then
         wtoxsc= tfact*resf
      else if(itc.eq.2) then
         wtoxsc= tfact*emut(itcn)
      else if(itc.eq.3) then
         if(itcn.eq.1) then
            wtoxsc= tfact*xt1mu
         else if(itcn.eq.2) then
            wtoxsc= tfact*xt2mu
         else if(itcn.eq.3) then
            wtoxsc= tfact*xt3mu
         else if(itcn.eq.4) then
            wtoxsc= tfact*xt4mu
         endif
      else if(itc.eq.4) then
         ewm= 0.5d0*(xp*(1.d0+sm-sp)-xdf*tw)
         bewms= 1.d0-vv*sm/ewm/ewm
         if(bewms.lt.0.d0) then
            wtoxsc= 0.d0
         else
            bewm= sqrt(bewms)
            ctwm= (1.d0-xm*tw/ewm)/bewm
            ctwm2= ctwm*ctwm
            if(itcn.eq.1) then
               wtoxsc= tfact*resf*ctwm
            else if(itcn.eq.2) then
               wtoxsc= tfact*resf*(2.d0*ctwm2-1.d0)
            else if(itcn.eq.3) then
               wtoxsc= tfact*resf*ctwm*(4.d0*ctwm2-3.d0)
            else if(itcn.eq.4) then
               wtoxsc= tfact*resf*(8.d0*ctwm2*(ctwm2-1.d0)+1.d0)
            endif
         endif
      else if(itc.eq.5) then
         ewp= 0.5d0*(xp*(1.d0+sp-sm)-xdf*omtw)
         bewps= 1.d0-vv*sp/ewp/ewp
         if(bewps.lt.0.d0) then
            wtoxsc= 0.d0
         else
            bewp= sqrt(bewps)
            ctwp= (1.d0-xm*omtw/ewp)/bewp
            ctwp2= ctwp*ctwp
            if(itcn.eq.1) then
               wtoxsc= tfact*resf*ctwp
            else if(itcn.eq.2) then
               wtoxsc= tfact*resf*(2.d0*ctwp2-1.d0)
            else if(itcn.eq.3) then
               wtoxsc= tfact*resf*ctwp*(4.d0*ctwp2-3.d0)
            else if(itcn.eq.4) then
               wtoxsc= tfact*resf*(8.d0*ctwp2*(ctwp2-1.d0)+1.d0)
            endif
         endif
      else if(itc.eq.6) then
         wtoxsc= tfact*resf*(sqrt(vv)*(ssm+ssp)-2.d0*rwm)**itcn
      endif
*
      return
      end