program gen_tinker_pot c c generates M charges around a molecule of N atoms c c CHAR.OPT ... file with options c NAMES.LST ... list of MD geometries c c DAM potential damping: c LSC solvent charges from CHAR.LST: c fnprm filename with MD FF: c NMC - number of MD confugurations c LPC - (logical) - bondary conditions c LAV - (logical) - construct average charge geometries c LAM - (logical) - construct average solvent molecular geometries c LAT - use MD (Tinker) charges for average solvent c LIN - interactive run c LSP - get potential from scratch POT.SCR c LLL - lebedev laikov distribution c LLC - cluster distribution and charge differences c cl.x cluster geometry c clq.txt atomic solvent charges c desired potential differences c LPALL- all 27 periodic boxes c LCONLY -calculate charges based on cav.x, FI.TXT and solute.x c LCO - conservative charges c RLL - lebedev laikov sphere radius c QTO - total charge c LSX - get potential from text file POT.TXT c LQ0 - minimize RMS from Tinker charges c LWR - larger output c DPCX,DPCY,DPCZ - lengths of box c N1,N2 - the potential is calculated at atoms N1...N2,NAT=N2-N1+1 c NMC number of geometries in NAMES.LST c NTM number of molecules of solvent to be found c NC - number of charges, NC.GE.NAT+2 c NAM0 - maximum number of atoms in one solvent molecule c maxit - maximum number of iteration for the group division c tol - maximum allowed change in the moment sum c M0 max number of atoms in one cube/MD configuration c implicit real*8 (a-h,o-z) implicit integer*4 (i-n) parameter (nat0=14000,nc0=4000,M0=8000,nc00=1000, 1nt0=4,NAM0=20,natall=500000,l=6000) character*8 nte character*1 s1 character*80 fn,s80,fnprm logical LPC,LWR,LAV,LAM,LAT,LIN,LQ0,LSP,LSX,LSC,LLL,LCO,lex, 1LPALL,LLC,LCONLY dimension ct(nc0),x(nat0),y(nat0),z(nat0),cti(M0),dfi(M0), 1izt(nc0),izq(nat0),c(M0),b(M0),a(M0,M0),ipiv(M0),cc(M0), 2work(3*M0*M0),q(nat0),xi(nc00),yi(nc00),zi(nc00),VV(M0), 3qi(nc00),di(nc00),a0(M0,M0),itk(nt0),ntk(nt0),xit(nc00), 4yit(nc00),zit(nc00),alistx(nc00,NAM0),iti(nc00), 5alisty(nc00,NAM0),alistz(nc00,NAM0),listi(nc00,NAM0) real*8 rijx(natall),rijy(natall),rijz(natall),cm(3), 1tkx(nc0),tky(nc0),tkz(nc0),R(3,nat0),AI(3,3),TI(3) common/bigc/rijx,rijy,rijz dimension xo(NAM0),yo(NAM0),zo(NAM0),xn(NAM0),yn(NAM0),zn(NAM0), 1xh(NAM0),yh(NAM0),zh(NAM0),iatom(natall), 2tlistx(natall,NAM0),tlisty(natall,NAM0),tlistz(natall,NAM0), 3itlist(natall,NAM0) common/mv2/xo,yo,zo,xh,yh,zh,tlistx,tlisty,tlistz,xn,yn,zn, 1NAM,NMC,ii1,iatom,itlist common/inter/LIN real*8 Xll,Yll,Zll,Wll common/llcommon/Xll(l),Yll(l),Zll(l),Wll(l) c c read/initialize options: call iopar(LAV,LAM,LAT,LPC,LSP,LQ0,LWR,LIN,NMC,NC, 1DPCX,DPCY,DPCZ,NAK,NAM,itk,ntk,NTM,N1,N2,fnprm,LCONLY, 2maxit,tol,toi,LSX,LSC,DAM,LLL,RLL,QTO,ALPHA,LCO,LPALL,LLC) open(3,file='CHAR.OUT') c c LCONLYLCONLYLCONLYLCONLYLCONLYLCONLYLCONLYLCONLYLCONLYLCONLY if(LCONLY)then c write(6,*)'Calculate charges on cav.x' write(6,*)'based on potential FI.TXT on solute.x' open(90,file='solute.x') read(90,*) read(90,*)NAT write(6,*)NAT,' - number of solute atoms' if(NAT.gt.nat0)call report('nat0 < NAT !') do 235 ia=1,NAT 235 read(90,*)izq(ia),x(ia),y(ia),z(ia) close(90) open(90,file='cav.x') read(90,*) read(90,*)NC write(6,*)NC,' - number of charges' if(NC.gt.nat0)call report('nat0 < NC !') do 236 ia=1,NC 236 read(90,*)ic,xi(ia),yi(ia),zi(ia) close(90) natc=NC+NAT M=NC+1 if(M.gt.M0)call report('M > M0!') open(8,file='FI.TXT') do 238 i=1,NAT 238 read(8,*)cc(i),cc(i),cc(i) close(8) write(6,6051) 6051 format('Potentials read from FI.TXT') c c predefined charges are zero: do 237 i=1,NC 237 q(i)=0.0d0 QTO=0.0d0 c c set up the matrix call setma(xi,yi,zi,x,y,z,NAT,NC,M0,ALPHA,M,a,VV,q,cc,QTO) if(LCO)then M=M else M=M-1 ENDIF do 239 i=1,M do 239 j=1,M 239 a0(i,j)=a(i,j) if(LWR)call wm(a,M0,M) call dgetrf(M,M,a,M0,ipiv,info) if(info.eq.0)then if(LIN)write(6,*)' Pivoting OK' write(3,*)' Pivoting OK' else call report('pivoting failed') endif c lwork=3*M*M call dgetri(M,a,M0,ipiv,work,lwork,info) c if(info.eq.0)write(6,*)'successful inversion' if(info.lt.0)then write(6,*)info call report('invalid argument') endif c c call icheck(toi,M,M0,a,a0) c b = a . VV: call avv(a,VV,b,M0,M) write(6,88) sum=0.0d0 do 240 i=1,NC write(6,897)i,q(i),b(i) 240 sum=sum+b(i) write(6,*)'charge sum new: ',sum sum=0.0d0 write(6,4567) do 241 ia=1,NAT pot=0.0d0 do 242 i=1,NC 242 pot=pot+ 1 b(i)/dsqrt((x(ia)-xi(i))**2+(y(ia)-yi(i))**2+(z(ia)-zi(i))**2) sum=sum+(cc(ia)-pot)**2 241 write(6,8989)ia,cc(ia),pot,pot-cc(ia) sum=dsqrt(sum/dble(NAT)) write(6,30933)sum call wrgeo('GEO.INP',NAT,izq,x,y,z,xi,yi,zi,b,NC) stop endif c LCONLYLCONLYLCONLYLCONLYLCONLYLCONLYLCONLYLCONLYLCONLYLCONLY dx2=DPCX/2.0d0 dy2=DPCY/2.0d0 dz2=DPCZ/2.0d0 NAT=N2-N1+1 M=NC+NAT+1 do 43 i=1,M 43 c(i)=0.0d0 if(NAT.gt.nat0)call report('nat0 < NAT !') if(NAM.gt.NAM0)call report('NAM < NAM0 !') if(M.gt.M0)call report('M > M0!') c control list: call co(NMC,NC,LPC,DPCX,DPCY,DPCZ,N1,N2,fnprm,NAT,M,DAM, 1ALPHA,LPALL,LCONLY) c c assign charges and atomic numbers to types if(LSC)then c solvent charges from a file: open(44,file='CHAR.LST') read(44,*)n if(n.gt.nc0)call report('n>nc0') do 71 i=1,n 71 read(44,*)ct(i) close(44) write(6,*)'Charges read from CHAR.LST' else do 7 i=1,nc0 izt(i)=0 7 ct(i)=0.0d0 nt=0 nz=0 c read Tinker FF: open(2,file=fnprm,status='OLD') 8 read(2,2828,end=9,err=9)s80 2828 format(a80) if(s80(1:4).eq.'atom')then read(s80(5:15),*)it read(s80(55:72),*)izta if(it.lt.nc0)then izt(it)=izta nz=nz+1 c write(6,6007)nz,it,izt(it) c6007 format(3i5) else call report('Too many atom types') endif close(55) endif if(s80(1:6).eq.'charge')then read(s80(7:80),*)it,qt if(it.lt.nc0)then ct(it)=qt nt=nt+1 c write(6,6006)nt,it,qt c6006 format(2i5,f8.4) else call report('Too many charge types') endif close(55) endif goto 8 9 close(2) write(3,*)nt,' charge types found in '//fnprm(1:40) if(LIN)write(6,*)nt,' charge types found in '//fnprm(1:40) write(3,*)nz,' atom types found in '//fnprm(1:40) if(LIN)write(6,*)nz,' atom types found in '//fnprm(1:40) endif open(2,file='NAMES.LST',status='OLD') do 3 i=1,NMC read(2,300)fn 300 format(a80) c write(6,*)fn(1:60) c read all atoms: open(21,file=fn,status='OLD') call ratmo(natmd,rijx,rijy,rijz,q,ct,izq,izt,nc0,LSX) inquire(file='ATCHARGES.TXT',exist=lex) if(lex)then open(20,file='ATCHARGES.TXT') read(20,*)nq if(nq.gt.nat0)call report('Too many charges in ATCHARGES.TXT') do 209 ja=1,nq 209 read(20,*)q(ja) close(20) endif c rewrite solute separately and add potential of the rest: c cm ... mass center do 2 ix=1,3 2 cm(ix)=0.0d0 do 1 ja=1,NAT x(ja)=rijx(ja+N1-1) y(ja)=rijy(ja+N1-1) z(ja)=rijz(ja+N1-1) R(1,ja)=x(ja) R(2,ja)=y(ja) R(3,ja)=z(ja) xj=x(ja) yj=y(ja) zj=z(ja) cm(1)=cm(1)+xj cm(2)=cm(2)+yj cm(3)=cm(3)+zj c c 27 periodic boxes if(LPALL)then vx=-DPCX-DPCX do 271 ibx=1,3 vx=vx+DPCX vy=-DPCY-DPCY do 271 iby=1,3 vy=vy+DPCY vz=-DPCZ-DPCZ do 271 ibz=1,3 vz=vz+DPCZ do 271 ia=1,natmd if((ia.lt.N1.or.ia.gt.N2). 1 or.ibx.ne.2.or.iby.ne.2.or.ibz.ne.2)then xa=rijx(ia)+vx ya=rijy(ia)+vy za=rijz(ia)+vz rc=dsqrt((xj-xa)**2+(yj-ya)**2+(zj-za)**2) if(DAM.gt.1.0D-7)then ee=exp(-(rc/DAM)**2) else ee=1.0d0 endif c(ja)=c(ja)+q(ia)*ee/rc endif 271 continue else c 1 box only: do 273 ia=1,natmd if(ia.lt.N1.or.ia.gt.N2)then xa=rijx(ia) ya=rijy(ia) za=rijz(ia) if(LPC)then call fixp(xj,xa,dx2,DPCX) call fixp(yj,ya,dy2,DPCY) call fixp(zj,za,dz2,DPCZ) endif rc=dsqrt((xj-xa)**2+(yj-ya)**2+(zj-za)**2) if(DAM.gt.1.0D-7)then ee=exp(-(rc/DAM)**2) else ee=1.0d0 endif c write(6,*)ia,ja,q(ia),rc,exp(-(rc/DAM)**2) c(ja)=c(ja)+q(ia)*ee/rc endif 273 continue endif 1 continue do 4 ix=1,3 4 cm(ix)=cm(ix)/dble(NAT) 3 close(21) write(3,*)NMC,' configurations read in' if(LIN)write(6,*)NMC,' configurations read in' potave=0.0d0 do 751 i=1,NAT c(i)=c(i)/dble(NMC) 751 potave=potave+c(i) potave=potave/dble(NAT) close(2) open(8,file='FI.TXT') do 75 i=1,NAT write(8,6000)i,c(i),c(i)-potave write(6,6000)i,c(i),c(i)-potave 75 c(i)=c(i)-potave 6000 format(i4,2f15.8) close(8) write(6,605) 605 format('Potential and its differences to average in FI.TXT') if(LSX)then icr=0 icl=0 open(8,file='POT.TXT',status='old') 2011 read(8,808,end=333,err=333)s1 808 format(a1) icl=icl+1 if(s1.ne.' ')then backspace(8) read(8,*)ja,c(nc+ja),c(nc+ja),c(nc+ja) icr=icr+1 endif goto 2011 333 close(8) write(3,*)'POT.TXT read,',icl,' lines,',icr,' charges.' if(LIN)write(6,*)'POT.TXT read,',icl,' lines,',icr,' charges.' endif open(8,file='POT.SCR',form='unformatted') if(LSP)then write(3,*)'POT.SCR read' if(LIN)write(6,*)'POT.SCR read' do 1411 ja=1,NAT 1411 read(8)c(ja) else do 111 ja=1,NAT 111 write(8)c(ja) write(3,*)'POT.SCR written' if(LIN)write(6,*)'POT.SCR written' endif close(8) c c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ if(LAV)then c c find "average" positions for solvent atoms c NAK ... Number of atoms kinds (e.g. 2 for h2o) c itk ... list of atom numbers c ntk ... number of each kind c c Loop for each kind of atoms ii=0 do 1001 ik=1,NAK write(3,*)'Selecting kind ',itk(ik),',',ntk(ik),' atoms' if(LIN)write(6,*)'Selecting kind ',itk(ik),',',ntk(ik),' atoms' ito=0 open(2,file='NAMES.LST',status='OLD') do 1003 i=1,NMC read(2,300)fn open(21,file=fn,status='OLD') call ratm(N1,N2,x,y,z,q,ct,izq,izt,nc0,LSX) rewind 21 read(21,*)natmd ic=0 do 161 ia=1,natmd read(21,2121)s1,xa,ya,za,it 2121 format(6x,2x,a1,2x,3f12.6,i6) if(it.eq.0.and.LSX)then if(s1.eq.'O')it=649 if(s1.eq.'H')it=650 c N,C,glycin types in amber.prm: if(s1.eq.'C')it=2 if(s1.eq.'N')it=1 izt(1)=7 izt(2)=6 izt(649)=8 izt(650)=1 endif if(ia.lt.N1.or.ia.gt.N2.and.it.eq.itk(ik))then qc=ct(it) ic=ic+1 xit(ic)=xa yit(ic)=ya zit(ic)=za di(ic)=dmin(NAT,x,y,z,LPC,xa,ya,za,dx2,dy2,dz2,DPCX, 1DPCY,DPCZ) qi(ic)=qc endif 161 continue close(21) if(ic.lt.ntk(ik))call report('Not enough charges was found') c c order charges do 281 ir=1,ic do 281 jr=ir+1,ic 281 if(di(jr).lt.di(ir))call sw(ir,jr,xit,yit,zit,qi,di) c c take ntk(ik) of them do 1004 ir=1,ntk(ik) ito=ito+1 if(ito.gt.natall)call report('ito overflow') rijx(ito)=xit(ir) rijy(ito)=yit(ir) 1004 rijz(ito)=zit(ir) 1003 continue c c now make NMC groups, each with ntk(ik) atoms open(45,file='tem1.x') write(45,*) write(45,*)ito do 10051 i=1,ito write(45,41)1,rijx(i),rijy(i),rijz(i) 10051 continue close(45) write(3,*)'tem1',ik if(LIN)write(6,*)'tem1',ik if(LIN)read(5,*) call makegr(NMC,ntk(ik),tkx,tky,tkz,iatom,maxit,tol) c c record the average charge positions open(45,file='tem2.x') write(45,*) write(45,*)ntk(ik) do 1005 i=1,ntk(ik) ii=ii+1 xi(ii)=dble(tkx(i)) yi(ii)=dble(tky(i)) zi(ii)=dble(tkz(i)) write(45,41)1,xi(ii),yi(ii),zi(ii) 41 format(i5,3f12.6) 1005 continue close(45) write(3,*)'tem2' if(LIN)write(6,*)'tem2' if(LIN)read(5,*) close(2) 1001 continue else c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c ***************************************************************** if(LAM)then c c find "average" positions for solvent molecules c NAM ... Number of atoms in the solvent molecule c NTM ... number of molecules of solvent to be found c write(3,*)'Selecting molecules each with ',NAM,' atoms' if(LIN)write(6,*)'Selecting molecules each with ',NAM,' atoms' ito=0 open(2,file='NAMES.LST',status='OLD') do 10031 i=1,NMC read(2,300)fn open(21,file=fn,status='OLD') c c read solute: call ratm(N1,N2,x,y,z,q,ct,izq,izt,nc0,LSX) rewind 21 c c read again to load molecules imol=0 read(21,*)natmd ia=0 162 ia=ia+1 if(ia.lt.N1.or.ia.gt.N2)then ctx=0.0d0 cty=0.0d0 ctz=0.0d0 imol=imol+1 c c read first atom extra so that periodic conditions can be fixed read(21,2121)s1,xj,yj,zj,it if(it.eq.0.and.LSX)then if(s1.eq.'O')it=649 if(s1.eq.'H')it=650 c N,C,glycin types in amber.prm: if(s1.eq.'C')it=2 if(s1.eq.'N')it=1 izt(1)=7 izt(2)=6 izt(649)=8 izt(650)=1 endif alistx(imol,1)=xj alisty(imol,1)=yj alistz(imol,1)=zj listi(imol,1)=it ctx=ctx+xj cty=cty+yj ctz=ctz+zj do 163 iia=2,NAM read(21,2121)s1,xa,ya,za,it if(it.eq.0.and.LSX)then if(s1.eq.'O')it=649 if(s1.eq.'H')it=650 c N,C,glycin types in amber.prm: if(s1.eq.'C')it=2 if(s1.eq.'N')it=1 izt(1)=7 izt(2)=6 izt(649)=8 izt(650)=1 endif if(LPC)then if(xa-xj.gt.dx2)xa=xa-DPCX if(xj-xa.gt.dx2)xa=xa+DPCX if(ya-yj.gt.dy2)ya=ya-DPCY if(yj-ya.gt.dy2)ya=ya+DPCY if(za-zj.gt.dz2)za=za-DPCZ if(zj-za.gt.dz2)za=za+DPCZ endif alistx(imol,iia)=xa alisty(imol,iia)=ya alistz(imol,iia)=za listi(imol,iia)=it ctx=ctx+xa cty=cty+ya 163 ctz=ctz+za ctx=ctx/dble(NAM) cty=cty/dble(NAM) ctz=ctz/dble(NAM) xit(imol)=ctx yit(imol)=cty zit(imol)=ctz ia=ia+NAM-1 c c determine distance of the molecular center to the solute: di(imol)=dmin(NAT,x,y,z,LPC,ctx,cty,ctz,dx2,dy2,dz2,DPCX, 1 DPCY,DPCZ) else read(21,*) endif if(ia.lt.natmd)goto 162 close(21) if(imol.lt.NTM)call report('Not enough solvent molecules found') c c order solvent do 2811 ir=1,imol do 2811 jr=ir+1,imol 2811 if(di(jr).lt.di(ir))call swm(ir,jr,xit,yit,zit,qi,di, 1alistx,alisty,alistz,NAM0,NAM,listi,nc00) c c take first NTM of them do 10041 ir=1,NTM ito=ito+1 if(ito.gt.natall)call report('ito overflow') do 10042 ia=1,NAM itlist(ito,ia)=listi(ir,ia) tlistx(ito,ia)=alistx(ir,ia) tlisty(ito,ia)=alisty(ir,ia) 10042 tlistz(ito,ia)=alistz(ir,ia) rijx(ito)=xit(ir) rijy(ito)=yit(ir) 10041 rijz(ito)=zit(ir) c c record geometry of this configuration open(8,file='scr') write(8,8000)i,'MC.x' 8000 format(i6,a4) rewind 8 read(8,8001)nte 8001 format(a10) close(8) if(LWR)then do 101 ist=1,len(nte) 101 if(nte(ist:ist).ne.' ')goto 102 102 open(8,file=nte(ist:len(nte))) write(8,8001)nte write(8,*)NTM*NAM+N2-N1+1 do 20041 ia=1,N2-N1+1 20041 write(8,41)izq(ia),x(ia),y(ia),z(ia) do 20042 ir=1,NTM do 20042 ia=1,NAM it=1 if(listi(ir,ia).eq.649)it=8 20042 write(8,41)it,alistx(ir,ia),alisty(ir,ia),alistz(ir,ia) close(8) endif 10031 continue close(2) open(45,file='temallm.x') write(45,*) write(45,*)ito*(1+NAM) do 11051 i=1,ito write(45,41)9,rijx(i),rijy(i),rijz(i) do 11051 j=1,NAM it=1 if(itlist(i,j).eq.649)it=8 11051 write(45,41)it,tlistx(i,j),tlisty(i,j),tlistz(i,j) close(45) c c now make NMC groups, each with NTM molecules call makegr(NMC,NTM,tkx,tky,tkz,iatom,maxit,tol) c c record the average positions open(45,file='avem.x') write(45,*) write(45,*)NTM do 1105 i=1,NTM 1105 write(45,41)9,tkx(i),tky(i),tkz(i) close(45) write(3,*)'avem.x' if(LIN)write(6,*)'avem.x' c open(45,file='whole.x') open(46,file='whole.scr',form='unformatted') write(45,*) write(45,*)NTM*NAM write(46)NTM*NAM c for each molecule, get the best orientation do 1106 im=1,NTM c c get the first molecule in the group ii1=NMC*(im-1)+1 iig=iatom(ii1) tx=0.0d0 ty=0.0d0 tz=0.0d0 do 1107 ia=1,NAM xo(ia)=tlistx(iig,ia) yo(ia)=tlisty(iig,ia) zo(ia)=tlistz(iig,ia) tx=tx+xo(ia) ty=ty+yo(ia) 1107 tz=tz+zo(ia) c c subtract center do 1108 ia=1,NAM xo(ia)=xo(ia)-tx/dble(NAM) yo(ia)=yo(ia)-ty/dble(NAM) 1108 zo(ia)=zo(ia)-tz/dble(NAM) c c optimize orientation call mopti c c shift to center and write to file do 1109 ia=1,NAM xo(ia)=xn(ia)+dble(tkx(im)) yo(ia)=yn(ia)+dble(tky(im)) zo(ia)=zn(ia)+dble(tkz(im)) it=1 if(itlist(iig,ia).eq.649)it=8 write(46)itlist(iig,ia),xo(ia),yo(ia),zo(ia) 1109 write(45,41)it,xo(ia),yo(ia),zo(ia) 1106 continue close(45) close(46) write(3,*)'whole.x' if(LIN)write(6,*)'whole.x' c c calculate average potential with tinker charges do 1110 ja=1,NAT 1110 cti(nc+ja)=0.0d0 c open(46,file='whole.scr',form='unformatted') read(46)na1 do 1111 ia=1,na1 read(46)it,xc,yc,zc qc=ct(it) qi(ia)=qc xi(ia)=xc yi(ia)=yc zi(ia)=zc iti(ia)=it do 1111 ja=1,NAT r2=(xc-x(ja))**2+(yc-y(ja))**2+(zc-z(ja))**2 1111 cti(nc+ja)=cti(nc+ja)+qc/dsqrt(r2) close(46) write(3,*)' MD ave pot. ave positions/tinker charge pot' if(LIN)write(6,*) 1' MD ave pot. ave positions/tinker charge pot' do 1112 ja=1,NAT if(LIN)write(6,609)ja,izq(ja),c(nc+ja),cti(nc+ja) 1112 write(3,609)ja,izq(ja),c(nc+ja),cti(nc+ja) 609 format(2i4,2f15.6) else c lllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllll c lebedev-laikov sphere if(LLL)then call ll(NC,np,0) NC=np c c rotation according to inertia moment CALL INERTIA(R,AI,TI,NAT,nat0) do i=1,np Xll(i)=Xll(i)*RLL Yll(i)=Yll(i)*RLL Zll(i)=Zll(i)*RLL xi(i)=cm(1)+AI(1,1)*Xll(i)+AI(1,2)*Yll(i)+AI(1,3)*Zll(i) yi(i)=cm(2)+AI(2,1)*Xll(i)+AI(2,2)*Yll(i)+AI(2,3)*Zll(i) zi(i)=cm(3)+AI(3,1)*Xll(i)+AI(3,2)*Yll(i)+AI(3,3)*Zll(i) enddo write(3,*)'Lebedev Laikov points:' do i=1,np write(3,309)i,Xll(i),Yll(i),Zll(i),Wll(i),Xi(i),Yi(i),Zi(i) 309 format(i3,7f10.5) enddo c record the charge positions in separate file: open(45,file='laik.x') write(45,*) write(45,*)np do 14051 i=1,np 14051 write(45,41)9,xi(i),yi(i),zi(i) close(45) write(3,*)'laik.x' if(LIN)write(6,*)'laik.x written' c c set up the matrix M=NC+1 if(M.gt.M0)call report('M>M0') do 141 i=1,M do 141 j=1,M 141 a(i,j)=0.0d0 do 151 i=1,NC a(i,i)=a(i,i)+ALPHA a(i,M)=1.0d0 a(M,i)=1.0d0 VV(i)=0.0d0 do 151 ia=1,NAT 151 VV(i)=VV(i)+c(ia)/ 1 dsqrt((x(ia)-xi(i))**2+(y(ia)-yi(i))**2+(z(ia)-zi(i))**2) do 261 ic=1,NC do 261 jc=1,NC do 261 ia=1,NAT xa=x(ia) ya=y(ia) za=z(ia) rii=dsqrt((xi(ic)-xa)**2+(yi(ic)-ya)**2+(zi(ic)-za)**2) rij=dsqrt((xi(jc)-xa)**2+(yi(jc)-ya)**2+(zi(jc)-za)**2) 261 a(ic,jc)=a(ic,jc)+1.0d0/rii/rij if(LCO)then M=M else M=M-1 ENDIF do 17 i=1,M do 17 j=1,M 17 a0(i,j)=a(i,j) if(LWR)call wm(a,M0,M) call dgetrf(M,M,a,M0,ipiv,info) if(info.eq.0)then if(LIN)write(6,*)' Pivoting OK' write(3,*)' Pivoting OK' else call report('pivoting failed') endif c lwork=3*M*M call dgetri(M,a,M0,ipiv,work,lwork,info) c if(info.eq.0)write(3,*)'successful inversion' if(info.eq.0.and.LIN)write(6,*)'successful inversion' if(info.lt.0)then write(3,*)info if(LIN)write(6,*)info call report('invalid argument') endif c call icheck(toi,M,M0,a,a0) c b = a . VV: call avv(a,VV,b,M0,M) write(3,88) if(LIN)write(6,88) sum=0.0d0 do 201 i=1,NC if(LIN)write(6,897)i,0.0d0,b(i) sum=sum+b(i) 201 write(3,897)i,0.0d0,b(i) 897 format(i6,2f20.10) if(LIN)write(6,*)'sum:',sum write(3,*)'sum:',sum c record the charge positions in separate file: open(45,file='whole.x') write(45,*) write(45,*)np+NAT do 34051 i=1,NAT 34051 write(45,411)izq(i+N1-1),x(i),y(i),z(i),0.0 do 24051 i=1,np 24051 write(45,411)9,xi(i),yi(i),zi(i),b(i) 411 format(i5,3f12.6,' 0 0 0 0 0 0 0 ',f8.4) close(45) write(3,*)'whole.x' if(LIN)write(6,*)'whole.x written' sum=0.0d0 write(3,*)'Potential old new' if(LIN)write(6,*)'Potential old new' do 211 ia=1,NAT pot=0.0d0 do 212 i=1,NC 212 pot=pot+ 1 b(i)/dsqrt((x(ia)-xi(i))**2+(y(ia)-yi(i))**2+(z(ia)-zi(i))**2) write(3,8989)ia,c(ia),pot 8989 format(i6,4f20.10) sum=sum+(c(ia)-pot)**2 211 if(LIN)write(6,8989)ia,c(ia),pot write(3,30933)sum if(LIN)write(6,30933)sum 30933 format(' Error:',f20.10) call wrgeo('GEO.INP',NAT,izq,x,y,z,xi,yi,zi,b,NC) stop endif c lllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllllll c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c cluster of solute and solvent molecules if(LLC)then write(6,*)'cluster of solute and solvent molecules in cl.x' write(6,*)NAT,' - number of solute atoms' open(90,file='cl.x') read(90,*) read(90,*)natc write(6,*)natc,' - number of cluster atoms' NC=natc-NAT write(6,*)NC,' - number of solvent atoms' do 232 ia=1,NAT 232 read(90,*)ic,x(ia),y(ia),z(ia) do 233 ia=1,NC 233 read(90,*)ic,xi(ia),yi(ia),zi(ia) close(90) M=NC+1 if(M.gt.M0)call report('M>M0') open(20,file='ATCHARGES.TXT') read(20,*) do 2091 ja=1,NC 2091 read(20,*)q(ja) close(20) do 234 ia=1,NAT c(ia)=0.0d0 do 234 i=1,NC 234 c(ia)=c(ia)+q(i)/ 1 dsqrt((x(ia)-xi(i))**2+(y(ia)-yi(i))**2+(z(ia)-zi(i))**2) write(3,*)'atomic charge positions:' do 2094 i=1,NC 2094 write(3,309)i,Xi(i),Yi(i),Zi(i) open(20,file='dfi.txt') do 2092 ja=1,NAT read(20,*)dfi(ja) 2092 cc(ja)=c(ja)+dfi(ja) close(20) write(6,*)'potentials old corrected:' do 2093 i=1,NAT 2093 write(6,309)i,c(i),cc(i) c record the charge positions in separate file: open(45,file='laik.x') write(45,*) write(45,*)NC do 14052 i=1,NC 14052 write(45,41)9,xi(i),yi(i),zi(i) close(45) write(3,*)'laik.x' if(LIN)write(6,*)'laik.x written' c c set up the matrix and the vector QTO=0.0d0 do ic=1,NC QTO=QTO+q(ic) enddo call setma(xi,yi,zi,x,y,z,NAT,NC,M0,ALPHA,M,a,VV,q,cc,QTO) c write(6,*)'charge sum old: ',QTO write(6,*)'alpha',alpha write(6,*)'LCO:',LCO if(LCO)then M=M else M=M-1 ENDIF do 171 i=1,M do 171 j=1,M 171 a0(i,j)=a(i,j) if(LWR)call wm(a,M0,M) call dgetrf(M,M,a,M0,ipiv,info) if(info.eq.0)then if(LIN)write(6,*)' Pivoting OK' write(3,*)' Pivoting OK' else call report('pivoting failed') endif c lwork=3*M*M call dgetri(M,a,M0,ipiv,work,lwork,info) c if(info.eq.0)write(6,*)'successful inversion' if(info.lt.0)then write(6,*)info call report('invalid argument') endif c call icheck(toi,M,M0,a,a0) c b = a . VV: call avv(a,VV,b,M0,M) write(3,88) sum=0.0d0 do 202 i=1,NC write(3,897)i,q(i),b(i) 202 sum=sum+b(i) write(6,*)'charge sum new: ',sum write(3,*)'charge sum new: ',sum c record the charge positions in separate file: open(45,file='whole.x') write(45,*) write(45,*)NC+NAT do 34052 i=1,NAT 34052 write(45,411)izq(i+N1-1),x(i),y(i),z(i),0.0 do 24052 i=1,NC 24052 write(45,411)9,xi(i),yi(i),zi(i),b(i) close(45) write(6,*)'whole.x written' sum=0.0d0 write(6,4567) 4567 format('Potential',14x,'old',17x,'new',16x,'diff',12x,'diff-req') do 2111 ia=1,NAT pot=0.0d0 do 2124 i=1,NC 2124 pot=pot+ 1 b(i)/dsqrt((x(ia)-xi(i))**2+(y(ia)-yi(i))**2+(z(ia)-zi(i))**2) sum=sum+(cc(ia)-pot)**2 2111 write(6,8989)ia,c(ia),pot,pot-c(ia),dfi(ia) write(6,30933)sum call wrgeo('GEO.INP',NAT,izq,x,y,z,xi,yi,zi,b,NC) call wrgeo('GEO0.INP',NAT,izq,x,y,z,xi,yi,zi,q,NC) stop endif c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c ***************************************************************** c select NC charges for mapping in the first geometry ic=0 open(2,file='NAMES.LST',status='OLD') read(2,300)fn open(21,file=fn,status='OLD') call ratm(N1,N2,x,y,z,q,ct,izq,izt,nc0,LSX) rewind 21 read(21,*)natmd do 61 ia=1,natmd read(21,2121)s1,xa,ya,za,it if(it.eq.0.and.LSX)then if(s1.eq.'O')it=649 if(s1.eq.'H')it=650 c N,C,glycin types in amber.prm: if(s1.eq.'C')it=2 if(s1.eq.'N')it=1 izt(1)=7 izt(2)=6 izt(649)=8 izt(650)=1 endif if(ia.lt.N1.or.ia.gt.N2)then qc=ct(it) ic=ic+1 xi(ic)=xa yi(ic)=ya zi(ic)=za di(ic)=dmin(NAT,x,y,z,LPC,xa,ya,za,dx2,dy2,dz2,DPCX, 1DPCY,DPCZ) qi(ic)=qc endif 61 continue close(21) close(2) if(ic.lt.NC)call report('Not enough charges was found') c c order charges do 28 i=1,ic do 28 j=i+1,ic 28 if(di(j).lt.di(i))call sw(i,j,xi,yi,zi,qi,di) c if(LWR)write(3,*)'charge distance from molecule' if(LWR.and.LIN)write(6,*)'charge distance from molecule' do 26 i=1,NC if(LWR)write(3,2626)i,di(i)**0.5d0,qi(i) 26 if(LWR.and.LIN)write(6,2626)i,di(i)**0.5d0,qi(i) 2626 format(i6,2f12.6) endif endif c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ c if(LAM.and.LAT)then write(3,*)' Tinker charges left for average mol. positions' if(LIN)write(6,*) 1 ' Tinker charges left for average mol. positions' do 120 i=1,NC 120 b(i)=qi(i) else if(LQ0)then write(3,*)'charges close to original seeked' do 5 i=1,NC 5 c(i)=qi(i) else write(3,*)'minimal charges seeked' endif c c set up the matrix do 14 i=1,M do 14 j=1,M 14 a(i,j)=0.0d0 do 15 i=1,NC a(i,i)=1.0d0 a(i,M)=1.0d0 15 a(M,i)=1.0d0 do 16 ia=1,NAT xa=x(ia) ya=y(ia) za=z(ia) do 16 ic=1,NC rij=dsqrt((xi(ic)-xa)**2+(yi(ic)-ya)**2+(zi(ic)-za)**2) a(NC+ia,ic)=1.0d0/rij 16 a(ic,NC+ia)=1.0d0/rij do 172 i=1,M do 172 j=1,M 172 a0(i,j)=a(i,j) if(LWR)call wm(a,M0,M) M1=M M2=M call dgetrf(M1,M2,a,M0,ipiv,info) if(info.eq.0)then if(LIN)write(6,*)' Pivoting OK' write(3,*)' Pivoting OK' else call report('pivoting failed') endif c lwork=3*M*M call dgetri(M,a,M0,ipiv,work,lwork,info) c if(info.eq.0)write(3,*)'successful inversion' if(info.eq.0.and.LIN)write(6,*)'successful inversion' if(info.lt.0)then write(3,*)info if(LIN)write(6,*)info call report('invalid argument') endif c call icheck(toi,M,M0,a,a0) c b = a . c: call avv(a,c,b,M0,M) endif write(3,88) if(LIN)write(6,88) 88 format(' charge old new') do 20 i=1,NC if(LIN)write(6,89)i,qi(i),b(i) 20 write(3,89)i,qi(i),b(i) 89 format(i6,2f10.2) open(4,file='GEO.X') write(4,*)' Atoms and charges from genchar' write(4,*)NAT+NC do 21 ia=1,NAT 21 write(4,3121)izq(ia),x(ia),y(ia),z(ia),q(ia) 3121 format(i6,3f12.6,' 0 0 0 0 0 0 0 ',f10.2) do 22 ic=1,NC iy=9 if(LAM)then iy=1 if(iti(ic).eq.649)iy=8 endif 22 write(4,3121)iy,xi(ic),yi(ic),zi(ic),b(ic) close(4) write(3,*)' GEO.X written' if(LIN)write(6,*)' GEO.X written' call wrgeo('GEO.INP',NAT,izq,x,y,z,xi,yi,zi,b,NC) write(3,*)'test pot old new' if(LIN)write(6,*)'test pot old new' do 25 ia=1,nat pot=0.0d0 do 27 ic=1,nc 27 pot=pot+b(ic)/dsqrt((x(ia)-xi(ic))**2+(y(ia)-yi(ic))**2 1 +(z(ia)-zi(ic))**2) if(LIN)write(6,2525)ia,c(ia+NC),pot 25 write(3,2525)ia,c(ia+NC),pot 2525 format(i6,2f12.6) close(3) stop end c ============================================================ subroutine setma(xi,yi,zi,x,y,z,NAT,NC,M0,ALPHA,M,a,VV,q,cc, 1qtot) implicit none integer*4 i,j,NC,NAT,M0,M,ia real*8 xi(*),yi(*),zi(*),x(*),y(*),z(*),a(M0,M0),ALPHA,VV(*), 1q(*),cc(*),qtot do 142 i=1,NC do 142 j=1,NC if(i.eq.j)then a(i,i)=ALPHA else a(i,j)=0.0d0 endif a(i,M)=1.0d0 a(M,i)=1.0d0 do 142 ia=1,NAT 142 a(i,j)=a(i,j)+1.0d0/ 1dsqrt((xi(i)-x(ia))**2+(yi(i)-y(ia))**2+(zi(i)-z(ia))**2)/ 2dsqrt((xi(j)-x(ia))**2+(yi(j)-y(ia))**2+(zi(j)-z(ia))**2) a(M,M)=0.0d0 c c set up the vector do 152 i=1,NC VV(i)=ALPHA*q(i) do 152 ia=1,NAT 152 VV(i)=VV(i)+cc(ia)/ 1dsqrt((x(ia)-xi(i))**2+(y(ia)-yi(i))**2+(z(ia)-zi(i))**2) VV(M)=qtot return end c ============================================================ subroutine icheck(tol,nmo,M0,a,a0) implicit none integer*4 nmo,i,j,ii,M0,ic real*8 tol,sum,sum2,a(M0,M0),a0(M0,M0) do i=1,nmo do j=1,nmo sum=0.0d0 sum2=0.0d0 do ii=1,nmo sum=sum+a(i,ii)*a0(ii,j) sum2=sum2+a(ii,i)*a0(j,ii) enddo ic=0 if(abs(sum ).gt.tol.and.i.ne.j)ic=1 if(abs(sum2).gt.tol.and.i.ne.j)ic=2 if(abs(sum -1.0d0).gt.tol.and.i.eq.j)ic=3 if(abs(sum2-1.0d0).gt.tol.and.i.eq.j)ic=4 if(ic.ne.0)then write(6,*)'ic = ',ic write(6,*)i,j,sum,sum2 write(6,*)i,j,sum write(3,*)'ic = ',ic write(3,*)i,j,sum,sum2 write(3,*)i,j,sum call report('Inversion error') endif enddo enddo write(6,*)'Inversion Check OK' return end c ============================================================ subroutine avv(a,VV,b,M0,M) implicit none integer*4 M0,M,i,j real*8 b(*),VV(*),a(M0,M0) do 182 i=1,M b(i)=0.0d0 do 182 j=1,M 182 b(i)=b(i)+a(i,j)*VV(j) return end c ============================================================ subroutine wrgeo(s,NAT,izq,x,y,z,xi,yi,zi,b,NC) implicit none character*(*) s integer*4 NAT,izq(*),NC,ia,ic real*8 x(*),y(*),z(*),xi(*),yi(*),zi(*),b(*) open(4,file=s) write(4,400) 400 format('%mem=124000000',/, 1'%nproc=4',/, 3'#B3LYP/6-311++G** nmr nosymm charge',/, 4/, 5' Atoms and charges from gettinkerpot',/, 6/, 7'0 1 ') do 2311 ia=1,NAT 2311 write(4,2122)izq(ia),x(ia),y(ia),z(ia) 2122 format(i6,3f12.6) write(4,*) do 2411 ic=1,NC 2411 write(4,2123)xi(ic),yi(ic),zi(ic),b(ic) 2123 format(4f12.6) write(4,*) close(4) write(3,*)s,' written' write(6,*)s,' written' return end c =========================================== subroutine iopar(LAV,LAM,LAT,LPC,LSP,LQ0,LWR,LIN,NMC,NC, 1DPCX,DPCY,DPCZ,NAK,NAM,itk,ntk,NTM,N1,N2,fnprm,LCONLY, 2maxit,tol,toi,LSX,LSC,DAM,LLL,RLL,QTO,ALPHA,LCO,LPALL,LLC) implicit real*8 (a-h,o-z) implicit integer*4 (i-n) character*3 s3 character*(*) fnprm logical LPC,LWR,LAV,LAM,LAT,LIN,LQ0,LSP,LSX,LSC,LCO,LLL,LPALL,LLC, 1LCONLY dimension itk(*),ntk(*) LAV=.false. LCONLY=.false. LPALL=.false. LAM=.false. LAT=.false. LLL=.false. LLC=.false. LCO=.true. RLL=10.0d0 LPC=.false. LSP=.false. LQ0=.false. LWR=.false. LIN=.true. NMC=0 NC=0 ALPHA=1.0d-4 QTO=0.0d0 DPCX=0.0d0 DPCY=0.0d0 DPCZ=0.0d0 NAK=2 NAM=3 itk(1)=8 itk(2)=1 NTM=0 N1=1 N2=0 do 3 i=1,80 3 fnprm(i:i)=' ' fnprm(74:80)='par.prm' maxit=2000 tol=0.0d0 toi=1.0d-5 LSX=.false. LSC=.false. DAM=0.0d0 open(2,file='CHAR.OPT',status='OLD') 1 read(2,200,ERR=2,END=2)s3 200 format(a3) if(s3.eq.'LSC')read(2,*)LSC if(s3.eq.'ALP')read(2,*)ALPHA if(s3.eq.'DAM')read(2,*)DAM if(s3.eq.'LAV')read(2,*)LAV if(s3.eq.'LAM')read(2,*)LAM if(s3.eq.'LAT')read(2,*)LAT if(s3.eq.'LPC')read(2,*)LPC if(s3.eq.'LSP')read(2,*)LSP if(s3.eq.'LLL')read(2,*)LLL if(s3.eq.'LLC')read(2,*)LLC if(s3.eq.'LCO')read(2,*)LCO if(s3.eq.'LPA')read(2,*)LPALL if(s3.eq.'RLL')read(2,*)RLL if(s3.eq.'LSX')read(2,*)LSX if(s3.eq.'LQ0')read(2,*)LQ0 if(s3.eq.'LWR')read(2,*)LWR if(s3.eq.'LCN')read(2,*)LCONLY if(s3.eq.'INT')read(2,*)LIN if(s3.eq.'NMC')read(2,*)NMC if(s3.eq.'NCH')read(2,*)NC if(s3.eq.'DPC')read(2,*)DPCX,DPCY,DPCZ if(s3.eq.'NAK')read(2,*)NAK if(s3.eq.'NAM')read(2,*)NAM if(s3.eq.'ITK')read(2,*)iitk,itk(iitk) if(s3.eq.'NTK')read(2,*)intk,ntk(intk) if(s3.eq.'NTM')read(2,*)NTM if(s3.eq.'N1N')read(2,*)N1,N2 if(s3.eq.'QTO')read(2,*)QTO if(s3.eq.'PAR')read(2,*)fnprm if(s3.eq.'MAX')read(2,*)maxit if(s3.eq.'TOL')read(2,*)tol if(s3.eq.'TOI')read(2,*)toi if(s3.eq.'END')goto 2 goto 1 2 close(2) return end c =========================================== subroutine makegr(NCO,NO,tkx,tky,tkz,iatom,maxit,tol) implicit real*8 (a-h,o-z) parameter (natall=500000,nt0=4) real*8 rijx(natall),rijy(natall),rijz(natall),tkx(*), 1tky(*),tkz(*),s0,tol4 character*8 nte character*80 fnprm real*8 tol,DPCX,DPCY,DPCZ,toi integer*4 NCO,NO,ia,i,j,ii,iatom(*),maxit,it common/bigc/rijx,rijy,rijz logical LPC,LWR,LAV,LAM,LAT,LIN,LQ0,LSP,LSX,LPALL,LSC,LLL,LCO, 1LLC,LCONLY dimension itk(nt0),ntk(nt0) common/inter/LIN integer*4 time c c initialize groups tol4=tol RNCO=dble(NCO) do 1 ia=1,NO*NCO 1 iatom(ia)=ia s0= si(NO,iatom,NCO,rijx,rijy,rijz,tkx,tky,tkz) write(3,*)'Initial dispersion = ',s0 if(LIN)write(6,*)'Initial dispersion = ',s0 it0=time() it=0 c 44 sold=si(NO,iatom,NCO,rijx,rijy,rijz,tkx,tky,tkz) it=it+1 call iopar(LAV,LAM,LAT,LPC,LSP,LQ0,LWR,LIN,NMC,NC, 1DPCX,DPCY,DPCZ,NAK,NAM,itk,ntk,NTM,N1,N2,fnprm,LCONLY, 2maxit,tol,toi,LSX,LSC,DAM,LLL,RLL,QTO,ALPHA,LCO,LPALL,LLC) tol4=tol do 4 i1=1,NO t1x=tkx(i1) t1y=tky(i1) t1z=tkz(i1) ii1=NCO*(i1-1) do 4 j1=1,NCO ia1=iatom(ii1+j1) rijx1=rijx(ia1) rijy1=rijy(ia1) rijz1=rijz(ia1) do 4 i2=i1+1,NO t2x=tkx(i2)-t1x t2y=tky(i2)-t1y t2z=tkz(i2)-t1z ii2=NCO*(i2-1) do 4 j2=1,NCO ia2=iatom(ii2+j2) rijx2=rijx(ia2)-rijx1 rijy2=rijy(ia2)-rijy1 rijz2=rijz(ia2)-rijz1 rt=rijx2*t2x+rijy2*t2y+rijz2*t2z rh=(rijx2**2+rijy2**2+rijz2**2)/RNCO c c look if switching atoms 1 2 helps if(rt.lt.rh)then iatom(ii2+j2)=ia1 iatom(ii1+j1)=ia2 ia1=ia2 ia2=iatom(ii2+j2) rijx1=rijx(ia1) rijy1=rijy(ia1) rijz1=rijz(ia1) tkx(i1)=tkx(i1)+rijx2/RNCO tky(i1)=tky(i1)+rijy2/RNCO tkz(i1)=tkz(i1)+rijz2/RNCO tkx(i2)=tkx(i2)-rijx2/RNCO tky(i2)=tky(i2)-rijy2/RNCO tkz(i2)=tkz(i2)-rijz2/RNCO t1x=tkx(i1) t1y=tky(i1) t1z=tkz(i1) t2x=tkx(i2)-t1x t2y=tky(i2)-t1y t2z=tkz(i2)-t1z endif 4 continue s=si(NO,iatom,NCO,rijx,rijy,rijz,tkx,tky,tkz) write(3,6500)it,s,sold-s,tol4 if(LIN)write(6,6500)it,s,sold-s,tol4 6500 format(i6,' s = ',f15.6,', ds = ',f15.6,', tol = ',f10.4) if(sold-s.le.tol4)then write(3,*)' Change below limit achieved' if(LIN)write(6,*)' Change below limit achieved' goto 45 endif if(it.ge.maxit)then write(3,*)' Maximum number of iterations overflow' if(LIN)write(6,*)' Maximum number of iterations overflow' goto 45 endif goto 44 45 write(3,*)' time ',time()-it0 if(LIN)write(6,*)' time ',time()-it0 open(8,file='scr') do 8 i=1,NO rewind 8 write(8,8000)i,'.x' 8000 format(i6,a2) rewind 8 read(8,8001)nte 8001 format(a8) do 101 ist=1,len(nte) 101 if(nte(ist:ist).ne.' ')goto 102 102 open(45,file=nte(ist:len(nte))) write(45,8001)nte write(45,*)NCO+1 ii=NCO*(i-1) do 9 j=1,NCO ia=iatom(ii+j) 9 write(45,4545)rijx(ia),rijy(ia),rijz(ia) 4545 format(' 1 ',3f12.6) write(45,4546)tkx(i),tky(i),tkz(i) 4546 format(' 8 ',3f12.6) 8 close(45) close(8) return end c =========================================== function si(NO,iatom,NCO,rijx,rijy,rijz,tkx,tky,tkz) implicit real*8 (a-h,o-z) integer*4 NO,NCO,iatom(*) dimension rijx(*),rijy(*),rijz(*),tkx(*),tky(*), 1tkz(*) RNCO=dble(NCO) do 111 i=1,NO sx=0.0d0 sy=0.0d0 sz=0.0d0 ii=NCO*(i-1) do 211 j=1,NCO ia=iatom(ii+j) sx=sx+rijx(ia) sy=sy+rijy(ia) 211 sz=sz+rijz(ia) tkx(i)=sx/RNCO tky(i)=sy/RNCO 111 tkz(i)=sz/RNCO c s=0.0d0 do 51 i=1,NO tx=tkx(i) ty=tky(i) tz=tkz(i) ii=NCO*(i-1) do 51 j=1,NCO ia=iatom(ii+j) 51 s=s+(tx-rijx(ia))**2+(ty-rijy(ia))**2+(tz-rijz(ia))**2 si=s return end c =========================================== SUBROUTINE mopti IMPLICIT INTEGER*4 (I-N) IMPLICIT REAL*8 (A-H,O-Z) COMMON/MATVAR/A(3,3),RTOL,ITER parameter (NAM0=20,natall=500000) dimension xo(NAM0),yo(NAM0),zo(NAM0),xn(NAM0),yn(NAM0),zn(NAM0), 1xh(NAM0),yh(NAM0),zh(NAM0),iatom(natall), 2tlistx(natall,NAM0),tlisty(natall,NAM0),tlistz(natall,NAM0), 3itlist(natall,NAM0) common/mv2/xo,yo,zo,xh,yh,zh,tlistx,tlisty,tlistz,xn,yn,zn, 1NAM,NMC,ii1,iatom,itlist logical LIN common/inter/LIN CALL DOMATRIX(IERR) if(IERR.ne.0)call report('matrix not found') if(LIN)write(6,*)ITER write(3,*)ITER do 1 ia=1,NAM xn(ia)=A(1,1)*xo(ia)+A(1,2)*yo(ia)+A(1,3)*zo(ia) yn(ia)=A(2,1)*xo(ia)+A(2,2)*yo(ia)+A(2,3)*zo(ia) 1 zn(ia)=A(3,1)*xo(ia)+A(3,2)*yo(ia)+A(3,3)*zo(ia) return end SUBROUTINE DOMATRIX(IERR) C This is a Fortran version of Petr Malon's subroutine Amoeba IMPLICIT INTEGER*4 (I-N) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION ANG(3),P(4,3),Y(4),PBAR(3),PR(3),PRR(3) COMMON/MATVAR/A(3,3),RTOL,ITER IERR=0 C STARTING VALUES FOR THE ITERATION: ANG(1)=0.2d0 ANG(2)=0.0d0 ANG(3)=0.0d0 DO 1 I=1,3 1 P(1,I)=ANG(I) Y(1)=FU(ANG) ANG(2)=ANG(1) ANG(1)=0.0d0 DO 2 I=1,3 2 P(2,I)=ANG(I) Y(2)=FU(ANG) ANG(3)=ANG(2) ANG(2)=0.0d0 DO 3 I=1,3 3 P(3,I)=ANG(I) Y(3)=FU(ANG) ANG(1)=ANG(3) ANG(2)=ANG(3) ANG(3)=0.0d0 DO 4 I=1,3 4 P(4,I)=ANG(I) Y(4)=FU(ANG) FTOL=0.0000001d0 ITMAX=1500 ITER=0 99999 ILO=1 IF(Y(1).GT.Y(2))THEN IHI=1 INHI=2 ELSE IHI=2 INHI=1 ENDIF DO 5 I=1,4 IF(Y(I).LT.Y(ILO))ILO=I IF(Y(I).GT.Y(IHI))THEN INHI=IHI IHI=I ELSE IF(Y(I).GT.Y(INHI))THEN IF(I.NE.IHI)INHI=I ENDIF ENDIF 5 CONTINUE IF(ABS(Y(IHI))+ABS(Y(ILO)).LT.0.00000000001d0)THEN RTOL=0.0d0 ELSE RTOL=ABS(Y(IHI)-Y(ILO))/(ABS(Y(IHI))+ABS(Y(ILO)))*2.0d0 ENDIF IF(RTOL.LT.FTOL)RETURN IF(ITER.EQ.ITMAX)THEN WRITE(3,*)' Rotation has not converged !' IERR=1 RETURN ENDIF ITER=ITER+1 DO 55 I=1,3 55 PBAR(I)=0.0d0 DO 6 I=1,4 IF(I.NE.IHI)THEN DO 7 J=1,3 7 PBAR(J)=PBAR(J)+P(I,J) ENDIF 6 CONTINUE DO 8 J=1,3 PBAR(J)=PBAR(J)/3.0d0 8 PR(J)=2.0d0*PBAR(J)-P(IHI,J) YPR=FU(PR) IF(YPR.LE.Y(ILO))THEN DO 9 J=1,3 9 PRR(J)=2.0d0*PR(J)-PBAR(J) YPRR=FU(PRR) IF(YPRR.LT.Y(ILO))THEN DO 10 J=1,3 10 P(IHI,J)=PRR(J) Y(IHI)=YPRR ELSE DO 11 J=1,3 11 P(IHI,J)=PR(J) Y(IHI)=YPR ENDIF ELSE IF(YPR.GE.Y(INHI))THEN IF(YPR.LT.Y(IHI))THEN DO 12 J=1,3 12 P(IHI,J)=PR(J) Y(IHI)=YPR ENDIF DO 13 J=1,3 13 PRR(J)=0.5d0*P(IHI,J)+0.5d0*PBAR(J) YPRR=FU(PRR) IF(YPRR.LT.Y(IHI))THEN DO 14 J=1,3 14 P(IHI,J)=PRR(J) Y(IHI)=YPRR ELSE DO 15 I=1,4 IF(I.NE.ILO)THEN DO 16 J=1,3 PR(J)=0.5d0*(P(I,J)+P(ILO,J)) 16 P(I,J)=PR(J) Y(I)=FU(PR) ENDIF 15 CONTINUE ENDIF ELSE DO 17 J=1,3 17 P(IHI,J)=PR(J) Y(IHI)=YPR ENDIF ENDIF GOTO 99999 END subroutine fixp(xa,xj,dx2,DPCX) implicit none real*8 xa,xj,dx2,DPCX 1 if(xa-xj.gt.dx2)then xa=xa-DPCX goto 1 endif 2 if(xj-xa.gt.dx2)then xa=xa+DPCX goto 2 endif return end FUNCTION FU(ANG) IMPLICIT INTEGER*4 (I-N) IMPLICIT REAL*8 (A-H,O-Z) COMMON/MATVAR/A(3,3),RTOL,ITER parameter (NAM0=20,natall=500000) dimension xo(NAM0),yo(NAM0),zo(NAM0),xn(NAM0),yn(NAM0),zn(NAM0), 1xh(NAM0),yh(NAM0),zh(NAM0),iatom(natall), 2tlistx(natall,NAM0),tlisty(natall,NAM0),tlistz(natall,NAM0), 3itlist(natall,NAM0) common/mv2/xo,yo,zo,xh,yh,zh,tlistx,tlisty,tlistz,xn,yn,zn, 1NAM,NMC,ii1,iatom,itlist DIMENSION ANG(3) S1=SIN(ANG(1)) S2=SIN(ANG(2)) S3=SIN(ANG(3)) C1=COS(ANG(1)) C2=COS(ANG(2)) C3=COS(ANG(3)) C ang1 = theta C ang2 = phi C ang3 = cappa A(1,1)=C1*C2*C3-S2*S3 A(1,2)=C1*S2*C3+C2*S3 A(1,3)=-S1*C3 A(2,1)=-C1*C2*S3-S2*C3 A(2,2)=-C1*S2*S3+C2*C3 A(2,3)=S1*S3 A(3,1)=S1*C2 A(3,2)=S1*S2 A(3,3)=C1 R=0.0d0 c c rotate the molecule DO 1 I=1,NAM xn(I)=A(1,1)*xo(I)+A(1,2)*yo(I)+A(1,3)*zo(I) yn(I)=A(2,1)*xo(I)+A(2,2)*yo(I)+A(2,3)*zo(I) 1 zn(I)=A(3,1)*xo(I)+A(3,2)*yo(I)+A(3,3)*zo(I) c RNAM=dble(NAM) c loop over all configurations in the group do 2 j=1,NMC iig=iatom(ii1+j-1) tx=0.0d0 ty=0.0d0 tz=0.0d0 do 3 ia=1,NAM xh(ia)=tlistx(iig,ia) yh(ia)=tlisty(iig,ia) zh(ia)=tlistz(iig,ia) tx=tx+xh(ia) ty=ty+yh(ia) 3 tz=tz+zh(ia) tx=tx/RNAM ty=ty/RNAM tz=tz/RNAM do 4 ia=1,NAM xh(ia)=xh(ia)-tx yh(ia)=yh(ia)-ty 4 zh(ia)=zh(ia)-tz do 2 ia=1,NAM 2 R=R+(xh(ia)-xn(ia))**2+(yh(ia)-yn(ia))**2+(zh(ia)-zn(ia))**2 FU=R RETURN END C c c what is the minimum square distance from the molecule: function dmin(NAT,x,y,z,LPC,xa,ya,za,dx2,dy2,dz2,DPCX, 1DPCY,DPCZ) real*8 dmin,x(*),y(*),z(*),xj,yj,zj,rc,dmm, 1xa,ya,za,dx2,dy2,dz2,DPCY,DPCZ,DPCX integer*4 ja,NAT logical LPC dmm=1.0d20 do 101 ja=1,NAT xj=x(ja) yj=y(ja) zj=z(ja) if(LPC)then if(xa-xj.gt.dx2)xa=xa-DPCX if(xj-xa.gt.dx2)xa=xa+DPCX if(ya-yj.gt.dy2)ya=ya-DPCY if(yj-ya.gt.dy2)ya=ya+DPCY if(za-zj.gt.dz2)za=za-DPCZ if(zj-za.gt.dz2)za=za+DPCZ endif rc=(xj-xa)**2+(yj-ya)**2+(zj-za)**2 101 if(rc.lt.dmm)dmm=rc dmin=dmm return end c =========================================== subroutine ratm(N1,N2,x,y,z,q,ct,izq,izt,nc0,LSX) integer*4 N1,N2,ia,it,l,izq(*),izt(*),nc0 real*8 xa,ya,za,x(*),y(*),z(*),q(*),ct(*) character*1 s1 logical LSX c read(21,*) do 51 ia=1,N2 read(21,2121)s1,xa,ya,za,it 2121 format(6x,2x,a1,2x,3f12.6,i6) if(it.eq.0.and.LSX)then if(s1.eq.'O')it=649 if(s1.eq.'H')it=650 c N,C,glycin types in amber.prm: if(s1.eq.'C')it=2 if(s1.eq.'N')it=1 izt(1)=7 izt(2)=6 izt(649)=8 izt(650)=1 endif if(ia.ge.N1)then l=ia-N1+1 x(l)=xa y(l)=ya z(l)=za c fix missing type, e.g. in files from amber: if(it.lt.1)it=1 q(l)=ct(it) if(it.gt.nc0)then write(6,*)ia,it,nc0 call report('Invalid it.') endif izq(l)=izt(it) endif 51 continue return end c =========================================== subroutine ratmo(nat,x,y,z,q,ct,izq,izt,nc0,LSX) implicit none integer*4 nat,izq(*),izt(*),nc0,ia,it real*8 x(*),y(*),z(*),q(*),ct(*) character*1 s1 logical LSX c read(21,*)nat do 51 ia=1,nat read(21,2121)s1,x(ia),y(ia),z(ia),it 2121 format(6x,2x,a1,2x,3f12.6,i6) if(it.eq.0.and.LSX)then if(s1.eq.'O')it=649 if(s1.eq.'H')it=650 c N,C,glycin types in amber.prm: if(s1.eq.'C')it=2 if(s1.eq.'N')it=1 izt(1)=7 izt(2)=6 izt(649)=8 izt(650)=1 endif c fix missing type, e.g. in files from amber: if(it.lt.1)it=1 if(it.lt.1.or.it.gt.nc0)then write(3,*)ia,it,nc0 call report('Invalid it.') endif q(ia)=ct(it) 51 izq(ia)=izt(it) return end subroutine report(s) character*(*) s logical LIN common/inter/LIN write(3,*)s if(LIN)write(6,*)s stop end subroutine co(NMC,NC,LPC,DPCX,DPCY,DPCZ,N1,N2,fnprm,NAT,M,DAM, 1ALPHA,LPALL,LCONLY) implicit real*8 (a-h,o-z) implicit integer*4 (i-n) logical LPC character*(*) fnprm character*3 yy logical LIN,LPALL,LCONLY common/inter/LIN yy=' NO' if(LPC)yy='YES' write(3,6000)NMC,NC,M,yy,DPCX,DPCY,DPCZ,LPALL, 1N1,N2,fnprm(1:40),NAT,DAM, 1ALPHA,LCONLY if(LIN) 1write(6,6000)NMC,NC,M,yy,DPCX,DPCY,DPCZ,LPALL, 1N1,N2,fnprm(1:40),NAT,DAM, 1ALPHA,LCONLY 6000 format(' Number of MD configurations: ',I6,/, 1 ' Number of charges : ',I6,/, 1 ' M : ',I6,/, 2 ' Periodic bondary conditions: ',3x,A3,/, 3 ' Periodic bondary X : ',f12.6,/, 4 ' Periodic bondary y : ',f12.6,/, 5 ' Periodic bondary z : ',f12.6,/, 5 ' Look at all 27 boxes : ',L12,/, 6 ' Solvated molecule within : ',i6,' - ',i6,/, 7 ' MD force field : ',a40,/, 8 ' Number of atoms/pot. sites : ',i6,/, 8 ' Damping : ',F6.2,/, 8 ' Alpha : ',F12.6,/, 8 ' LCONLY : ',l12,/) return end subroutine wm(a,M0,M) integer*4 M0,M,i,j real*8 a(M0,M0) logical LIN common/inter/LIN do 1 i=1,M write(3,600)i if(LIN)write(6,600)i 600 format(' i = ',i6) if(LIN)write(6,606)(a(i,j),j=1,M) 1 write(3,606)(a(i,j),j=1,M) 606 format(6f12.6) return end subroutine swm(i,j,xi,yi,zi,qi,di,alistx,alisty,alistz,NAM0, 1NAM,listi,nc00) integer*4 i,j,NAM0,NAM,k,listi(nc00,NAM0) real*8 xi(*),yi(*),zi(*),qi(*),di(*), 1alistx(nc00,NAM0),alisty(nc00,NAM0),alistz(nc00,NAM0) call swr(xi(i),xi(j)) call swr(yi(i),yi(j)) call swr(zi(i),zi(j)) call swr(di(i),di(j)) call swr(qi(i),qi(j)) do 1 k=1,NAM call swi( listi(i,k), listi(j,k)) call swr(alistx(i,k),alistx(j,k)) call swr(alisty(i,k),alisty(j,k)) 1 call swr(alistz(i,k),alistz(j,k)) return end subroutine sw(i,j,xi,yi,zi,qi,di) integer*4 i,j real*8 xi(*),yi(*),zi(*),qi(*),di(*) call swr(xi(i),xi(j)) call swr(yi(i),yi(j)) call swr(zi(i),zi(j)) call swr(di(i),di(j)) call swr(qi(i),qi(j)) return end subroutine swr(a,b) real*8 a,b,c c=a a=b b=c return end subroutine swi(a,b) integer*4 a,b,c c=a a=b b=c return end subroutine ll(n0,np,ic) c Lebedev-Laikov grids c n0 ... requested number of points c np ... returned number of points c ic ... make reduction to 1 octant implicit none integer*4 np,n0,ic,i,l,j,k integer N parameter (l=6000) real*8 tol,X,Y,Z,W,sum common/llcommon/X(l),Y(l),Z(l),W(l) np=n0 if( np.le. 10)call LD0006(X,Y,Z,W,N) if(np.gt. 10.and.np.le. 20)call LD0014(X,Y,Z,W,N) if(np.gt. 20.and.np.le. 32)call LD0026(X,Y,Z,W,N) if(np.gt. 32.and.np.le. 44)call LD0038(X,Y,Z,W,N) if(np.gt. 44.and.np.le. 62)call LD0050(X,Y,Z,W,N) if(np.gt. 62.and.np.le. 80)call LD0074(X,Y,Z,W,N) if(np.gt. 80.and.np.le. 98)call LD0086(X,Y,Z,W,N) if(np.gt. 98.and.np.le. 128)call LD0110(X,Y,Z,W,N) if(np.gt. 128.and.np.le. 158)call LD0146(X,Y,Z,W,N) if(np.gt. 158.and.np.le. 182)call LD0170(X,Y,Z,W,N) if(np.gt. 182.and.np.le. 212)call LD0194(X,Y,Z,W,N) if(np.gt. 212.and.np.le. 248)call LD0230(X,Y,Z,W,N) if(np.gt. 248.and.np.le. 284)call LD0266(X,Y,Z,W,N) if(np.gt. 284.and.np.le. 326)call LD0302(X,Y,Z,W,N) if(np.gt. 326.and.np.le. 392)call LD0350(X,Y,Z,W,N) if(np.gt. 392.and.np.le. 512)call LD0434(X,Y,Z,W,N) if(np.gt. 512.and.np.le. 680)call LD0590(X,Y,Z,W,N) if(np.gt. 680.and.np.le. 872)call LD0770(X,Y,Z,W,N) if(np.gt. 872.and.np.le.1088)call LD0974(X,Y,Z,W,N) if(np.gt.1088.and.np.le.1328)call LD1202(X,Y,Z,W,N) if(np.gt.1328.and.np.le.1592)call LD1454(X,Y,Z,W,N) if(np.gt.1592.and.np.le.1880)call LD1730(X,Y,Z,W,N) if(np.gt.1880.and.np.le.2192)call LD2030(X,Y,Z,W,N) if(np.gt.2192.and.np.le.2528)call LD2354(X,Y,Z,W,N) if(np.gt.2528.and.np.le.2888)call LD2702(X,Y,Z,W,N) if(np.gt.2888.and.np.le.3272)call LD3074(X,Y,Z,W,N) if(np.gt.3272.and.np.le.3680)call LD3470(X,Y,Z,W,N) if(np.gt.3680.and.np.le.4112)call LD3890(X,Y,Z,W,N) if(np.gt.4112.and.np.le.4568)call LD4334(X,Y,Z,W,N) if(np.gt.4568.and.np.le.5048)call LD4802(X,Y,Z,W,N) if(np.gt.5048.and.np.le.5552)call LD5294(X,Y,Z,W,N) if(np.gt.5552) call LD5810(X,Y,Z,W,N) np=N write(6,600)n0,np 600 format(i4,' spherical points requested,',i4,' made.') if(ic.eq.1)then tol=1.0d-5 799 do i=1,np if(X(i).lt.-tol.or.Y(i).lt.-tol.or.Z(i).lt.-tol)then do j=1,i-1 if(X(j).ge.-tol.and.Y(j).ge.-tol.and.Z(j).ge.-tol. 1 and.abs(abs(X(i))-abs(X(j))).lt.tol. 2 and.abs(abs(Y(i))-abs(Y(j))).lt.tol. 3 and.abs(abs(Z(i))-abs(Z(j))).lt.tol)goto 789 enddo do j=i+1,np if(X(j).ge.-tol.and.Y(j).ge.-tol.and.Z(j).ge.-tol. 1 and.abs(abs(X(i))-abs(X(j))).lt.tol. 2 and.abs(abs(Y(i))-abs(Y(j))).lt.tol. 3 and.abs(abs(Z(i))-abs(Z(j))).lt.tol)goto 788 enddo write(6,*)i,X(i),Y(i),Z(i),W(i),np call report('positive image not found') endif enddo sum=0.0d0 do 5 i=1,np if(W(i).lt.0.0d0)call report('Negative weight.') 5 sum=sum+W(i) if(abs(sum-1.0d0).gt.1.0d-5)call report('Not normalized.') cdo i=1,np c if(abs(X(i)).lt.tol)W(i)=W(i)/2.0d0 c if(abs(Y(i)).lt.tol)W(i)=W(i)/2.0d0 c if(abs(Z(i)).lt.tol)W(i)=W(i)/2.0d0 cenddo write(6,601)np 601 format(i4,' points in positive octant left') return 788 X(i)=abs(X(i)) Y(i)=abs(Y(i)) Z(i)=abs(Z(i)) W(i)=W(i)+W(j) do k=j,np-1 X(k)=X(k+1) Y(k)=Y(k+1) Z(k)=Z(k+1) W(k)=W(k+1) enddo np=np-1 goto 799 789 W(j)=W(j)+W(i) do k=i,np-1 X(k)=X(k+1) Y(k)=Y(k+1) Z(k)=Z(k+1) W(k)=W(k+1) enddo np=np-1 goto 799 endif return end c c =========================================== c LAPACK ROUTINES: c =========================================== SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO ) * * -- LAPACK routine (version 3.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * June 30, 1999 * * .. Scalar Arguments .. INTEGER*4 INFO, LDA, LWORK, N * .. * .. Array Arguments .. INTEGER*4 IPIV( * ) DOUBLE PRECISION A( LDA, * ), WORK( * ) * .. * * Purpose * ======= * * DGETRI computes the inverse of a matrix using the LU factorization * computed by DGETRF. * * This method inverts U and then computes inv(A) by solving the system * inv(A)*L = inv(U) for inv(A). * * Arguments * ========= * * N (input) INTEGER * The order of the matrix A. N >= 0. * * A (input/output) DOUBLE PRECISION array, dimension (LDA,N) * On entry, the factors L and U from the factorization * A = P*L*U as computed by DGETRF. * On exit, if INFO = 0, the inverse of the original matrix A. * * LDA (input) INTEGER * The leading dimension of the array A. LDA >= max(1,N). * * IPIV (input) INTEGER*4 array, dimension (N) * The pivot indices from DGETRF; for 1<=i<=N, row i of the * matrix was interchanged with row IPIV(i). * * WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) * On exit, if INFO=0, then WORK(1) returns the optimal LWORK. * * LWORK (input) INTEGER * The dimension of the array WORK. LWORK >= max(1,N). * For optimal performance LWORK >= N*NB, where NB is * the optimal blocksize returned by ILAENV. * * If LWORK = -1, then a workspace query is assumed; the routine * only calculates the optimal size of the WORK array, returns * this value as the first entry of the WORK array, and no error * message related to LWORK is issued by XERBLA. * * INFO (output) INTEGER * = 0: successful exit * < 0: if INFO = -i, the i-th argument had an illegal value * > 0: if INFO = i, U(i,i) is exactly zero; the matrix is * singular and its inverse could not be computed. * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION ZERO, ONE PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) * .. * .. Local Scalars .. LOGICAL LQUERY INTEGER*4 I, IWS, J, JB, JJ, JP, LDWORK, LWKOPT, NB, $ NBMIN, NN * .. * .. External Functions .. INTEGER*4 ILAENV EXTERNAL ILAENV * .. * .. External Subroutines .. EXTERNAL DGEMM, DGEMV, DSWAP, DTRSM, DTRTRI, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. * .. Executable Statements .. * * Test the input parameters. * INFO = 0 NB = ILAENV( 1, 'DGETRI', ' ', N, -1, -1, -1 ) LWKOPT = N*NB WORK( 1 ) = LWKOPT LQUERY = ( LWORK.EQ.-1 ) IF( N.LT.0 ) THEN INFO = -1 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -3 ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN INFO = -6 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DGETRI', -INFO ) RETURN ELSE IF( LQUERY ) THEN RETURN END IF * * Quick return if possible * IF( N.EQ.0 ) $ RETURN * * Form inv(U). If INFO > 0 from DTRTRI, then U is singular, * and the inverse is not computed. * CALL DTRTRI( 'Upper', 'N', N, A, LDA, INFO ) IF( INFO.GT.0 ) $ RETURN * NBMIN = 2 LDWORK = N IF( NB.GT.1 .AND. NB.LT.N ) THEN IWS = MAX( LDWORK*NB, 1 ) IF( LWORK.LT.IWS ) THEN NB = LWORK / LDWORK NBMIN = MAX( 2, ILAENV( 2, 'DGETRI', ' ', N, -1, -1, -1 ) ) END IF ELSE IWS = N END IF * * Solve the equation inv(A)*L = inv(U) for inv(A). * IF( NB.LT.NBMIN .OR. NB.GE.N ) THEN * * Use unblocked code. * DO 20 J = N, 1, -1 * * Copy current column of L to WORK and replace with zeros. * DO 10 I = J + 1, N WORK( I ) = A( I, J ) A( I, J ) = ZERO 10 CONTINUE * * Compute current column of inv(A). * IF( J.LT.N ) $ CALL DGEMV( 'N', N, N-J, -ONE, A( 1, J+1 ), $ LDA, WORK( J+1 ), 1, ONE, A( 1, J ), 1 ) 20 CONTINUE ELSE * * Use blocked code. * NN = ( ( N-1 ) / NB )*NB + 1 DO 50 J = NN, 1, -NB JB = MIN( NB, N-J+1 ) * * Copy current block column of L to WORK and replace with * zeros. * DO 40 JJ = J, J + JB - 1 DO 30 I = JJ + 1, N WORK( I+( JJ-J )*LDWORK ) = A( I, JJ ) A( I, JJ ) = ZERO 30 CONTINUE 40 CONTINUE * * Compute current block column of inv(A). * IF( J+JB.LE.N ) $ CALL DGEMM( 'N', 'N', N, JB, $ N-J-JB+1, -ONE, A( 1, J+JB ), LDA, $ WORK( J+JB ), LDWORK, ONE, A( 1, J ), LDA ) CALL DTRSM( 'R', 'L', 'N', 'U', N, JB, $ ONE, WORK( J ), LDWORK, A( 1, J ), LDA ) 50 CONTINUE END IF * * Apply column interchanges. * DO 60 J = N - 1, 1, -1 JP = IPIV( J ) IF( JP.NE.J ) $ CALL DSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 ) 60 CONTINUE * WORK( 1 ) = IWS RETURN * * End of DGETRI * END SUBROUTINE DTRTI2( UPLO, DIAG, N, A, LDA, INFO ) * * -- LAPACK routine (version 3.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * February 29, 1992 * * .. Scalar Arguments .. CHARACTER DIAG, UPLO INTEGER*4 INFO, LDA, N * .. * .. Array Arguments .. DOUBLE PRECISION A( LDA, * ) * .. * * Purpose * ======= * * DTRTI2 computes the inverse of arreal upper or lower triangular * matrix. * * This is the Level 2 BLAS version of the algorithm. * * Arguments * ========= * * UPLO (input) CHARACTER*1 * Specifies whether the matrix A is upper or lower triangular. * = 'U': Upper triangular * = 'L': Lower triangular * * DIAG (input) CHARACTER*1 * Specifies whether or not the matrix A is unit triangular. * = 'N': Non-unit triangular * = 'U': Unit triangular * * N (input) INTEGER * The order of the matrix A. N >= 0. * * A (input/output) DOUBLE PRECISION array, dimension (LDA,N) * On entry, the triangular matrix A. If UPLO = 'U', the * leading n by n upper triangular part of the array A contains * the upper triangular matrix, and the strictly lower * triangular part of A is not referenced. If UPLO = 'L', the * leading n by n lower triangular part of the array A contains * the lower triangular matrix, and the strictly upper * triangular part of A is not referenced. If DIAG = 'U', the * diagonal elements of A are also not referenced and are * assumed to be 1. * * On exit, the (triangular) inverse of the original matrix, in * the same storage format. * * LDA (input) INTEGER * The leading dimension of the array A. LDA >= max(1,N). * * INFO (output) INTEGER * = 0: successful exit * < 0: if INFO = -k, the k-th argument had an illegal value * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION ONE PARAMETER ( ONE = 1.0D+0 ) * .. * .. Local Scalars .. LOGICAL NOUNIT, UPPER INTEGER*4 J DOUBLE PRECISION AJJ * .. * .. External Functions .. LOGICAL LBAME EXTERNAL LBAME * .. * .. External Subroutines .. EXTERNAL DSCAL, DTRMV, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX * .. * .. Executable Statements .. * * Test the input parameters. * INFO = 0 UPPER = LBAME( UPLO, 'U' ) NOUNIT = LBAME( DIAG, 'N' ) IF( .NOT.UPPER .AND. .NOT.LBAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.NOUNIT .AND. .NOT.LBAME( DIAG, 'U' ) ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -3 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -5 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DTRTI2', -INFO ) RETURN END IF * IF( UPPER ) THEN * * Compute inverse of upper triangular matrix. * DO 10 J = 1, N IF( NOUNIT ) THEN A( J, J ) = ONE / A( J, J ) AJJ = -A( J, J ) ELSE AJJ = -ONE END IF * * Compute elements 1:j-1 of j-th column. * CALL DTRMV( 'Upper', 'N', DIAG, J-1, A, LDA, $ A( 1, J ), 1 ) CALL DSCAL( J-1, AJJ, A( 1, J ), 1 ) 10 CONTINUE ELSE * * Compute inverse of lower triangular matrix. * DO 20 J = N, 1, -1 IF( NOUNIT ) THEN A( J, J ) = ONE / A( J, J ) AJJ = -A( J, J ) ELSE AJJ = -ONE END IF IF( J.LT.N ) THEN * * Compute elements j+1:n of j-th column. * CALL DTRMV( 'L', 'N', DIAG, N-J, $ A( J+1, J+1 ), LDA, A( J+1, J ), 1 ) CALL DSCAL( N-J, AJJ, A( J+1, J ), 1 ) END IF 20 CONTINUE END IF * RETURN * * End of DTRTI2 * END SUBROUTINE DTRTRI( UPLO, DIAG, N, A, LDA, INFO ) * * -- LAPACK routine (version 3.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * March 31, 1993 * * .. Scalar Arguments .. CHARACTER DIAG, UPLO INTEGER*4 INFO, LDA, N * .. * .. Array Arguments .. DOUBLE PRECISION A( LDA, * ) * .. * * Purpose * ======= * * DTRTRI computes the inverse of arreal upper or lower triangular * matrix A. * * This is the Level 3 BLAS version of the algorithm. * * Arguments * ========= * * UPLO (input) CHARACTER*1 * = 'U': A is upper triangular; * = 'L': A is lower triangular. * * DIAG (input) CHARACTER*1 * = 'N': A is non-unit triangular; * = 'U': A is unit triangular. * * N (input) INTEGER * The order of the matrix A. N >= 0. * * A (input/output) DOUBLE PRECISION array, dimension (LDA,N) * On entry, the triangular matrix A. If UPLO = 'U', the * leading N-by-N upper triangular part of the array A contains * the upper triangular matrix, and the strictly lower * triangular part of A is not referenced. If UPLO = 'L', the * leading N-by-N lower triangular part of the array A contains * the lower triangular matrix, and the strictly upper * triangular part of A is not referenced. If DIAG = 'U', the * diagonal elements of A are also not referenced and are * assumed to be 1. * On exit, the (triangular) inverse of the original matrix, in * the same storage format. * * LDA (input) INTEGER * The leading dimension of the array A. LDA >= max(1,N). * * INFO (output) INTEGER * = 0: successful exit * < 0: if INFO = -i, the i-th argument had an illegal value * > 0: if INFO = i, A(i,i) is exactly zero. The triangular * matrix is singular and its inverse can not be computed. * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION ONE, ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) * .. * .. Local Scalars .. LOGICAL NOUNIT, UPPER INTEGER*4 J, JB, NB, NN * .. * .. External Functions .. LOGICAL LBAME INTEGER*4 ILAENV EXTERNAL LBAME, ILAENV * .. * .. External Subroutines .. EXTERNAL DTRMM, DTRSM, DTRTI2, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. * .. Executable Statements .. * * Test the input parameters. * INFO = 0 UPPER = LBAME( UPLO, 'U' ) NOUNIT = LBAME( DIAG, 'N' ) IF( .NOT.UPPER .AND. .NOT.LBAME( UPLO, 'L' ) ) THEN INFO = -1 ELSE IF( .NOT.NOUNIT .AND. .NOT.LBAME( DIAG, 'U' ) ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -3 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -5 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DTRTRI', -INFO ) RETURN END IF * * Quick return if possible * IF( N.EQ.0 ) $ RETURN * * Check for singularity if non-unit. * IF( NOUNIT ) THEN DO 10 INFO = 1, N IF( A( INFO, INFO ).EQ.ZERO ) $ RETURN 10 CONTINUE INFO = 0 END IF * * Determine the block size for this environment. * NB = ILAENV( 1, 'DTRTRI', UPLO // DIAG, N, -1, -1, -1 ) IF( NB.LE.1 .OR. NB.GE.N ) THEN * * Use unblocked code * CALL DTRTI2( UPLO, DIAG, N, A, LDA, INFO ) ELSE * * Use blocked code * IF( UPPER ) THEN * * Compute inverse of upper triangular matrix * DO 20 J = 1, N, NB JB = MIN( NB, N-J+1 ) * * Compute rows 1:j-1 of current block column * CALL DTRMM( 'L', 'Upper', 'N', DIAG, J-1, $ JB, ONE, A, LDA, A( 1, J ), LDA ) CALL DTRSM( 'R', 'Upper', 'N', DIAG, J-1, $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA ) * * Compute inverse of current diagonal block * CALL DTRTI2( 'U', DIAG, JB, A( J, J ), LDA, INFO ) 20 CONTINUE ELSE * * Compute inverse of lower triangular matrix * NN = ( ( N-1 ) / NB )*NB + 1 DO 30 J = NN, 1, -NB JB = MIN( NB, N-J+1 ) IF( J+JB.LE.N ) THEN * * Compute rows j+jb:n of current block column * CALL DTRMM( 'L', 'L', 'N', DIAG, $ N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA, $ A( J+JB, J ), LDA ) CALL DTRSM( 'R', 'L', 'N', DIAG, $ N-J-JB+1, JB, -ONE, A( J, J ), LDA, $ A( J+JB, J ), LDA ) END IF * * Compute inverse of current diagonal block * CALL DTRTI2( 'L', DIAG, JB, A( J, J ), LDA, INFO ) 30 CONTINUE END IF END IF * RETURN * * End of DTRTRI * END LOGICAL FUNCTION LBAME( CA, CB ) * * -- LAPACK auxiliary routine (version 3.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * September 30, 1994 * * .. Scalar Arguments .. CHARACTER CA, CB * .. * * Purpose * ======= * * LBAME returns .TRUE. if CA is the same letter as CB regardless of * case. * * Arguments * ========= * * CA (input) CHARACTER*1 * CB (input) CHARACTER*1 * CA and CB specify the single characters to be compared. * * ===================================================================== * * .. Intrinsic Functions .. INTRINSIC ICHAR * .. * .. Local Scalars .. INTEGER*4 INTA, INTB, ZCODE * .. * .. Executable Statements .. * * Test if the characters are equal * LBAME = CA.EQ.CB IF( LBAME ) $ RETURN * * Now test for equivalence if both characters are alphabetic. * ZCODE = ICHAR( 'Z' ) * * Use 'Z' rather than 'A' so that ASCII can be detected on Prime * machines, on which ICHAR returns a value with bit 8 set. * ICHAR('A') on Prime machines returns 193 which is the same as * ICHAR('A') on an EBCDIC machine. * INTA = ICHAR( CA ) INTB = ICHAR( CB ) * IF( ZCODE.EQ.90 .OR. ZCODE.EQ.122 ) THEN * * ASCII is assumed - ZCODE is the ASCII code of either lower or * upper case 'Z'. * IF( INTA.GE.97 .AND. INTA.LE.122 ) INTA = INTA - 32 IF( INTB.GE.97 .AND. INTB.LE.122 ) INTB = INTB - 32 * ELSE IF( ZCODE.EQ.233 .OR. ZCODE.EQ.169 ) THEN * * EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or * upper case 'Z'. * IF( INTA.GE.129 .AND. INTA.LE.137 .OR. $ INTA.GE.145 .AND. INTA.LE.153 .OR. $ INTA.GE.162 .AND. INTA.LE.169 ) INTA = INTA + 64 IF( INTB.GE.129 .AND. INTB.LE.137 .OR. $ INTB.GE.145 .AND. INTB.LE.153 .OR. $ INTB.GE.162 .AND. INTB.LE.169 ) INTB = INTB + 64 * ELSE IF( ZCODE.EQ.218 .OR. ZCODE.EQ.250 ) THEN * * ASCII is assumed, on Prime machines - ZCODE is the ASCII code * plus 128 of either lower or upper case 'Z'. * IF( INTA.GE.225 .AND. INTA.LE.250 ) INTA = INTA - 32 IF( INTB.GE.225 .AND. INTB.LE.250 ) INTB = INTB - 32 END IF LBAME = INTA.EQ.INTB * * RETURN * * End of LBAME * END SUBROUTINE XERBLA( SRNAME, INFO ) * * -- LAPACK auxiliary routine (version 3.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * September 30, 1994 * * .. Scalar Arguments .. CHARACTER*6 SRNAME INTEGER*4 INFO * .. * * Purpose * ======= * * XERBLA is an error handler for the LAPACK routines. * It is called by an LAPACK routine if an input parameter has an * invalid value. A message is printed and execution stops. * * Installers may consider modifying the STOP statement in order to * call system-specific exception-handling facilities. * * Arguments * ========= * * SRNAME (input) CHARACTER*6 * The name of the routine which called XERBLA. * * INFO (input) INTEGER * The position of the invalid parameter in the parameter list * of the calling routine. * * ===================================================================== * * .. Executable Statements .. * WRITE( *, FMT = 9999 )SRNAME, INFO * STOP * 9999 FORMAT( ' ** On entry to ', A6, ' parameter number ', I2, ' had ', $ 'an illegal value' ) * * End of XERBLA * END SUBROUTINE DGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, $ BETA, C, LDC ) * .. Scalar Arguments .. CHARACTER*1 TRANSA, TRANSB INTEGER*4 M, N, K, LDA, LDB, LDC DOUBLE PRECISION ALPHA, BETA * .. Array Arguments .. DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( LDC, * ) * .. * * Purpose * ======= * * DGEMM performs one of the matrix-matrix operations * * C := alpha*op( A )*op( B ) + beta*C, * * where op( X ) is one of * * op( X ) = X or op( X ) = X', * * alpha and beta are scalars, and A, B and C are matrices, with op( A ) * an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. * * Parameters * ========== * * TRANSA - CHARACTER*1. * On entry, TRANSA specifies the form of op( A ) to be used in * the matrix multiplication as follows: * * TRANSA = 'N' or 'n', op( A ) = A. * * TRANSA = 'T' or 't', op( A ) = A'. * * TRANSA = 'C' or 'c', op( A ) = A'. * * Unchanged on exit. * * TRANSB - CHARACTER*1. * On entry, TRANSB specifies the form of op( B ) to be used in * the matrix multiplication as follows: * * TRANSB = 'N' or 'n', op( B ) = B. * * TRANSB = 'T' or 't', op( B ) = B'. * * TRANSB = 'C' or 'c', op( B ) = B'. * * Unchanged on exit. * * M - INTEGER. * On entry, M specifies the number of rows of the matrix * op( A ) and of the matrix C. M must be at least zero. * Unchanged on exit. * * N - INTEGER. * On entry, N specifies the number of columns of the matrix * op( B ) and the number of columns of the matrix C. N must be * at least zero. * Unchanged on exit. * * K - INTEGER. * On entry, K specifies the number of columns of the matrix * op( A ) and the number of rows of the matrix op( B ). K must * be at least zero. * Unchanged on exit. * * ALPHA - DOUBLE PRECISION. * On entry, ALPHA specifies the scalar alpha. * Unchanged on exit. * * A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is * k when TRANSA = 'N' or 'n', and is m otherwise. * Before entry with TRANSA = 'N' or 'n', the leading m by k * part of the array A must contain the matrix A, otherwise * the leading k by m part of the array A must contain the * matrix A. * Unchanged on exit. * * LDA - INTEGER. * On entry, LDA specifies the first dimension of A as declared * in the calling (sub) program. When TRANSA = 'N' or 'n' then * LDA must be at least max( 1, m ), otherwise LDA must be at * least max( 1, k ). * Unchanged on exit. * * B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is * n when TRANSB = 'N' or 'n', and is k otherwise. * Before entry with TRANSB = 'N' or 'n', the leading k by n * part of the array B must contain the matrix B, otherwise * the leading n by k part of the array B must contain the * matrix B. * Unchanged on exit. * * LDB - INTEGER. * On entry, LDB specifies the first dimension of B as declared * in the calling (sub) program. When TRANSB = 'N' or 'n' then * LDB must be at least max( 1, k ), otherwise LDB must be at * least max( 1, n ). * Unchanged on exit. * * BETA - DOUBLE PRECISION. * On entry, BETA specifies the scalar beta. When BETA is * supplied as zero then C need not be set on input. * Unchanged on exit. * * C - DOUBLE PRECISION array of DIMENSION ( LDC, n ). * Before entry, the leading m by n part of the array C must * contain the matrix C, except when beta is zero, in which * case C need not be set on entry. * On exit, the array C is overwritten by the m by n matrix * ( alpha*op( A )*op( B ) + beta*C ). * * LDC - INTEGER. * On entry, LDC specifies the first dimension of C as declared * in the calling (sub) program. LDC must be at least * max( 1, m ). * Unchanged on exit. * * * Level 3 Blas routine. * * -- Written on 8-February-1989. * Jack Dongarra, Argonne National Laboratory. * Iain Duff, AERE Harwell. * Jeremy Du Croz, Numerical Algorithms Group Ltd. * Sven Hammarling, Numerical Algorithms Group Ltd. * * * .. External Functions .. LOGICAL LBAME EXTERNAL LBAME * .. External Subroutines .. EXTERNAL XERBLA * .. Intrinsic Functions .. INTRINSIC MAX * .. Local Scalars .. LOGICAL NOTA, NOTB INTEGER*4 I, INFO, J, L, NROWA, NROWB DOUBLE PRECISION TEMP * .. Parameters .. DOUBLE PRECISION ONE , ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) * .. * .. Executable Statements .. * * Set NOTA and NOTB as true if A and B respectively are not * transposed and set NROWA, NCOLA and NROWB as the number of rows * and columns of A and the number of rows of B respectively. * NOTA = LBAME( TRANSA, 'N' ) NOTB = LBAME( TRANSB, 'N' ) IF( NOTA )THEN NROWA = M c NCOLA = K ELSE NROWA = K c NCOLA = M END IF IF( NOTB )THEN NROWB = K ELSE NROWB = N END IF * * Test the input parameters. * INFO = 0 IF( ( .NOT.NOTA ).AND. $ ( .NOT.LBAME( TRANSA, 'C' ) ).AND. $ ( .NOT.LBAME( TRANSA, 'T' ) ) )THEN INFO = 1 ELSE IF( ( .NOT.NOTB ).AND. $ ( .NOT.LBAME( TRANSB, 'C' ) ).AND. $ ( .NOT.LBAME( TRANSB, 'T' ) ) )THEN INFO = 2 ELSE IF( M .LT.0 )THEN INFO = 3 ELSE IF( N .LT.0 )THEN INFO = 4 ELSE IF( K .LT.0 )THEN INFO = 5 ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN INFO = 8 ELSE IF( LDB.LT.MAX( 1, NROWB ) )THEN INFO = 10 ELSE IF( LDC.LT.MAX( 1, M ) )THEN INFO = 13 END IF IF( INFO.NE.0 )THEN CALL XERBLA( 'DGEMM ', INFO ) RETURN END IF * * Quick return if possible. * IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR. $ ( ( ( ALPHA.EQ.ZERO ).OR.( K.EQ.0 ) ).AND.( BETA.EQ.ONE ) ) ) $ RETURN * * And if alpha.eq.zero. * IF( ALPHA.EQ.ZERO )THEN IF( BETA.EQ.ZERO )THEN DO 20, J = 1, N DO 10, I = 1, M C( I, J ) = ZERO 10 CONTINUE 20 CONTINUE ELSE DO 40, J = 1, N DO 30, I = 1, M C( I, J ) = BETA*C( I, J ) 30 CONTINUE 40 CONTINUE END IF RETURN END IF * * Start the operations. * IF( NOTB )THEN IF( NOTA )THEN * * Form C := alpha*A*B + beta*C. * DO 90, J = 1, N IF( BETA.EQ.ZERO )THEN DO 50, I = 1, M C( I, J ) = ZERO 50 CONTINUE ELSE IF( BETA.NE.ONE )THEN DO 60, I = 1, M C( I, J ) = BETA*C( I, J ) 60 CONTINUE END IF DO 80, L = 1, K IF( B( L, J ).NE.ZERO )THEN TEMP = ALPHA*B( L, J ) DO 70, I = 1, M C( I, J ) = C( I, J ) + TEMP*A( I, L ) 70 CONTINUE END IF 80 CONTINUE 90 CONTINUE ELSE * * Form C := alpha*A'*B + beta*C * DO 120, J = 1, N DO 110, I = 1, M TEMP = ZERO DO 100, L = 1, K TEMP = TEMP + A( L, I )*B( L, J ) 100 CONTINUE IF( BETA.EQ.ZERO )THEN C( I, J ) = ALPHA*TEMP ELSE C( I, J ) = ALPHA*TEMP + BETA*C( I, J ) END IF 110 CONTINUE 120 CONTINUE END IF ELSE IF( NOTA )THEN * * Form C := alpha*A*B' + beta*C * DO 170, J = 1, N IF( BETA.EQ.ZERO )THEN DO 130, I = 1, M C( I, J ) = ZERO 130 CONTINUE ELSE IF( BETA.NE.ONE )THEN DO 140, I = 1, M C( I, J ) = BETA*C( I, J ) 140 CONTINUE END IF DO 160, L = 1, K IF( B( J, L ).NE.ZERO )THEN TEMP = ALPHA*B( J, L ) DO 150, I = 1, M C( I, J ) = C( I, J ) + TEMP*A( I, L ) 150 CONTINUE END IF 160 CONTINUE 170 CONTINUE ELSE * * Form C := alpha*A'*B' + beta*C * DO 200, J = 1, N DO 190, I = 1, M TEMP = ZERO DO 180, L = 1, K TEMP = TEMP + A( L, I )*B( J, L ) 180 CONTINUE IF( BETA.EQ.ZERO )THEN C( I, J ) = ALPHA*TEMP ELSE C( I, J ) = ALPHA*TEMP + BETA*C( I, J ) END IF 190 CONTINUE 200 CONTINUE END IF END IF * RETURN * * End of DGEMM . * END SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, $ BETA, Y, INCY ) * .. Scalar Arguments .. DOUBLE PRECISION ALPHA, BETA INTEGER*4 INCX, INCY, LDA, M, N CHARACTER*1 TRANS * .. Array Arguments .. DOUBLE PRECISION A( LDA, * ), X( * ), Y( * ) * .. * * Purpose * ======= * * DGEMV performs one of the matrix-vector operations * * y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, * * where alpha and beta are scalars, x and y are vectors and A is an * m by n matrix. * * Parameters * ========== * * TRANS - CHARACTER*1. * On entry, TRANS specifies the operation to be performed as * follows: * * TRANS = 'N' or 'n' y := alpha*A*x + beta*y. * * TRANS = 'T' or 't' y := alpha*A'*x + beta*y. * * TRANS = 'C' or 'c' y := alpha*A'*x + beta*y. * * Unchanged on exit. * * M - INTEGER. * On entry, M specifies the number of rows of the matrix A. * M must be at least zero. * Unchanged on exit. * * N - INTEGER. * On entry, N specifies the number of columns of the matrix A. * N must be at least zero. * Unchanged on exit. * * ALPHA - DOUBLE PRECISION. * On entry, ALPHA specifies the scalar alpha. * Unchanged on exit. * * A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). * Before entry, the leading m by n part of the array A must * contain the matrix of coefficients. * Unchanged on exit. * * LDA - INTEGER. * On entry, LDA specifies the first dimension of A as declared * in the calling (sub) program. LDA must be at least * max( 1, m ). * Unchanged on exit. * * X - DOUBLE PRECISION array of DIMENSION at least * ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' * and at least * ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. * Before entry, the incremented array X must contain the * vector x. * Unchanged on exit. * * INCX - INTEGER. * On entry, INCX specifies the increment for the elements of * X. INCX must not be zero. * Unchanged on exit. * * BETA - DOUBLE PRECISION. * On entry, BETA specifies the scalar beta. When BETA is * supplied as zero then Y need not be set on input. * Unchanged on exit. * * Y - DOUBLE PRECISION array of DIMENSION at least * ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' * and at least * ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. * Before entry with BETA non-zero, the incremented array Y * must contain the vector y. On exit, Y is overwritten by the * updated vector y. * * INCY - INTEGER. * On entry, INCY specifies the increment for the elements of * Y. INCY must not be zero. * Unchanged on exit. * * * Level 2 Blas routine. * * -- Written on 22-October-1986. * Jack Dongarra, Argonne National Lab. * Jeremy Du Croz, Nag Central Office. * Sven Hammarling, Nag Central Office. * Richard Hanson, Sandia National Labs. * * * .. Parameters .. DOUBLE PRECISION ONE , ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) * .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER*4 I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY * .. External Functions .. LOGICAL LBAME EXTERNAL LBAME * .. External Subroutines .. EXTERNAL XERBLA * .. Intrinsic Functions .. INTRINSIC MAX * .. * .. Executable Statements .. * * Test the input parameters. * INFO = 0 IF ( .NOT.LBAME( TRANS, 'N' ).AND. $ .NOT.LBAME( TRANS, 'T' ).AND. $ .NOT.LBAME( TRANS, 'C' ) )THEN INFO = 1 ELSE IF( M.LT.0 )THEN INFO = 2 ELSE IF( N.LT.0 )THEN INFO = 3 ELSE IF( LDA.LT.MAX( 1, M ) )THEN INFO = 6 ELSE IF( INCX.EQ.0 )THEN INFO = 8 ELSE IF( INCY.EQ.0 )THEN INFO = 11 END IF IF( INFO.NE.0 )THEN CALL XERBLA( 'DGEMV ', INFO ) RETURN END IF * * Quick return if possible. * IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR. $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) ) $ RETURN * * Set LENX and LENY, the lengths of the vectors x and y, and set * up the start points in X and Y. * IF( LBAME( TRANS, 'N' ) )THEN LENX = N LENY = M ELSE LENX = M LENY = N END IF IF( INCX.GT.0 )THEN KX = 1 ELSE KX = 1 - ( LENX - 1 )*INCX END IF IF( INCY.GT.0 )THEN KY = 1 ELSE KY = 1 - ( LENY - 1 )*INCY END IF * * Start the operations. In this version the elements of A are * accessed sequentially with one pass through A. * * First form y := beta*y. * IF( BETA.NE.ONE )THEN IF( INCY.EQ.1 )THEN IF( BETA.EQ.ZERO )THEN DO 10, I = 1, LENY Y( I ) = ZERO 10 CONTINUE ELSE DO 20, I = 1, LENY Y( I ) = BETA*Y( I ) 20 CONTINUE END IF ELSE IY = KY IF( BETA.EQ.ZERO )THEN DO 30, I = 1, LENY Y( IY ) = ZERO IY = IY + INCY 30 CONTINUE ELSE DO 40, I = 1, LENY Y( IY ) = BETA*Y( IY ) IY = IY + INCY 40 CONTINUE END IF END IF END IF IF( ALPHA.EQ.ZERO ) $ RETURN IF( LBAME( TRANS, 'N' ) )THEN * * Form y := alpha*A*x + y. * JX = KX IF( INCY.EQ.1 )THEN DO 60, J = 1, N IF( X( JX ).NE.ZERO )THEN TEMP = ALPHA*X( JX ) DO 50, I = 1, M Y( I ) = Y( I ) + TEMP*A( I, J ) 50 CONTINUE END IF JX = JX + INCX 60 CONTINUE ELSE DO 80, J = 1, N IF( X( JX ).NE.ZERO )THEN TEMP = ALPHA*X( JX ) IY = KY DO 70, I = 1, M Y( IY ) = Y( IY ) + TEMP*A( I, J ) IY = IY + INCY 70 CONTINUE END IF JX = JX + INCX 80 CONTINUE END IF ELSE * * Form y := alpha*A'*x + y. * JY = KY IF( INCX.EQ.1 )THEN DO 100, J = 1, N TEMP = ZERO DO 90, I = 1, M TEMP = TEMP + A( I, J )*X( I ) 90 CONTINUE Y( JY ) = Y( JY ) + ALPHA*TEMP JY = JY + INCY 100 CONTINUE ELSE DO 120, J = 1, N TEMP = ZERO IX = KX DO 110, I = 1, M TEMP = TEMP + A( I, J )*X( IX ) IX = IX + INCX 110 CONTINUE Y( JY ) = Y( JY ) + ALPHA*TEMP JY = JY + INCY 120 CONTINUE END IF END IF * RETURN * * End of DGEMV . * END subroutine dswap (n,dx,incx,dy,incy) c c interchanges two vectors. c uses unrolled loops for increments equal one. c jack dongarra, linpack, 3/11/78. c modified 12/3/93, array(1) declarations changed to array(*) c real*8 dx(*),dy(*),dtemp integer*4 i,incx,incy,ix,iy,m,mp1,n c if(n.le.0)return if(incx.eq.1.and.incy.eq.1)go to 20 c c code for unequal increments or equal increments not equal c to 1 c ix = 1 iy = 1 if(incx.lt.0)ix = (-n+1)*incx + 1 if(incy.lt.0)iy = (-n+1)*incy + 1 do 10 i = 1,n dtemp = dx(ix) dx(ix) = dy(iy) dy(iy) = dtemp ix = ix + incx iy = iy + incy 10 continue return c c code for both increments equal to 1 c c c clean-up loop c 20 m = mod(n,3) if( m .eq. 0 ) go to 40 do 30 i = 1,m dtemp = dx(i) dx(i) = dy(i) dy(i) = dtemp 30 continue if( n .lt. 3 ) return 40 mp1 = m + 1 do 50 i = mp1,n,3 dtemp = dx(i) dx(i) = dy(i) dy(i) = dtemp dtemp = dx(i + 1) dx(i + 1) = dy(i + 1) dy(i + 1) = dtemp dtemp = dx(i + 2) dx(i + 2) = dy(i + 2) dy(i + 2) = dtemp 50 continue return end SUBROUTINE DTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, $ B, LDB ) * .. Scalar Arguments .. CHARACTER*1 SIDE, UPLO, TRANSA, DIAG INTEGER*4 M, N, LDA, LDB DOUBLE PRECISION ALPHA * .. Array Arguments .. DOUBLE PRECISION A( LDA, * ), B( LDB, * ) * .. * * Purpose * ======= * * DTRMM performs one of the matrix-matrix operations * * B := alpha*op( A )*B, or B := alpha*B*op( A ), * * where alpha is a scalar, B is an m by n matrix, A is a unit, or * non-unit, upper or lower triangular matrix and op( A ) is one of * * op( A ) = A or op( A ) = A'. * * Parameters * ========== * * SIDE - CHARACTER*1. * On entry, SIDE specifies whether op( A ) multiplies B from * the left or right as follows: * * SIDE = 'L' or 'l' B := alpha*op( A )*B. * * SIDE = 'R' or 'r' B := alpha*B*op( A ). * * Unchanged on exit. * * UPLO - CHARACTER*1. * On entry, UPLO specifies whether the matrix A is an upper or * lower triangular matrix as follows: * * UPLO = 'U' or 'u' A is an upper triangular matrix. * * UPLO = 'L' or 'l' A is a lower triangular matrix. * * Unchanged on exit. * * TRANSA - CHARACTER*1. * On entry, TRANSA specifies the form of op( A ) to be used in * the matrix multiplication as follows: * * TRANSA = 'N' or 'n' op( A ) = A. * * TRANSA = 'T' or 't' op( A ) = A'. * * TRANSA = 'C' or 'c' op( A ) = A'. * * Unchanged on exit. * * DIAG - CHARACTER*1. * On entry, DIAG specifies whether or not A is unit triangular * as follows: * * DIAG = 'U' or 'u' A is assumed to be unit triangular. * * DIAG = 'N' or 'n' A is not assumed to be unit * triangular. * * Unchanged on exit. * * M - INTEGER. * On entry, M specifies the number of rows of B. M must be at * least zero. * Unchanged on exit. * * N - INTEGER. * On entry, N specifies the number of columns of B. N must be * at least zero. * Unchanged on exit. * * ALPHA - DOUBLE PRECISION. * On entry, ALPHA specifies the scalar alpha. When alpha is * zero then A is not referenced and B need not be set before * entry. * Unchanged on exit. * * A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m * when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'. * Before entry with UPLO = 'U' or 'u', the leading k by k * upper triangular part of the array A must contain the upper * triangular matrix and the strictly lower triangular part of * A is not referenced. * Before entry with UPLO = 'L' or 'l', the leading k by k * lower triangular part of the array A must contain the lower * triangular matrix and the strictly upper triangular part of * A is not referenced. * Note that when DIAG = 'U' or 'u', the diagonal elements of * A are not referenced either, but are assumed to be unity. * Unchanged on exit. * * LDA - INTEGER. * On entry, LDA specifies the first dimension of A as declared * in the calling (sub) program. When SIDE = 'L' or 'l' then * LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' * then LDA must be at least max( 1, n ). * Unchanged on exit. * * B - DOUBLE PRECISION array of DIMENSION ( LDB, n ). * Before entry, the leading m by n part of the array B must * contain the matrix B, and on exit is overwritten by the * transformed matrix. * * LDB - INTEGER. * On entry, LDB specifies the first dimension of B as declared * in the calling (sub) program. LDB must be at least * max( 1, m ). * Unchanged on exit. * * * Level 3 Blas routine. * * -- Written on 8-February-1989. * Jack Dongarra, Argonne National Laboratory. * Iain Duff, AERE Harwell. * Jeremy Du Croz, Numerical Algorithms Group Ltd. * Sven Hammarling, Numerical Algorithms Group Ltd. * * * .. External Functions .. LOGICAL LBAME EXTERNAL LBAME * .. External Subroutines .. EXTERNAL XERBLA * .. Intrinsic Functions .. INTRINSIC MAX * .. Local Scalars .. LOGICAL LSIDE, NOUNIT, UPPER INTEGER*4 I, INFO, J, K, NROWA DOUBLE PRECISION TEMP * .. Parameters .. DOUBLE PRECISION ONE , ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) * .. * .. Executable Statements .. * * Test the input parameters. * LSIDE = LBAME( SIDE , 'L' ) IF( LSIDE )THEN NROWA = M ELSE NROWA = N END IF NOUNIT = LBAME( DIAG , 'N' ) UPPER = LBAME( UPLO , 'U' ) * INFO = 0 IF( ( .NOT.LSIDE ).AND. $ ( .NOT.LBAME( SIDE , 'R' ) ) )THEN INFO = 1 ELSE IF( ( .NOT.UPPER ).AND. $ ( .NOT.LBAME( UPLO , 'L' ) ) )THEN INFO = 2 ELSE IF( ( .NOT.LBAME( TRANSA, 'N' ) ).AND. $ ( .NOT.LBAME( TRANSA, 'T' ) ).AND. $ ( .NOT.LBAME( TRANSA, 'C' ) ) )THEN INFO = 3 ELSE IF( ( .NOT.LBAME( DIAG , 'U' ) ).AND. $ ( .NOT.LBAME( DIAG , 'N' ) ) )THEN INFO = 4 ELSE IF( M .LT.0 )THEN INFO = 5 ELSE IF( N .LT.0 )THEN INFO = 6 ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN INFO = 9 ELSE IF( LDB.LT.MAX( 1, M ) )THEN INFO = 11 END IF IF( INFO.NE.0 )THEN CALL XERBLA( 'DTRMM ', INFO ) RETURN END IF * * Quick return if possible. * IF( N.EQ.0 ) $ RETURN * * And when alpha.eq.zero. * IF( ALPHA.EQ.ZERO )THEN DO 20, J = 1, N DO 10, I = 1, M B( I, J ) = ZERO 10 CONTINUE 20 CONTINUE RETURN END IF * * Start the operations. * IF( LSIDE )THEN IF( LBAME( TRANSA, 'N' ) )THEN * * Form B := alpha*A*B. * IF( UPPER )THEN DO 50, J = 1, N DO 40, K = 1, M IF( B( K, J ).NE.ZERO )THEN TEMP = ALPHA*B( K, J ) DO 30, I = 1, K - 1 B( I, J ) = B( I, J ) + TEMP*A( I, K ) 30 CONTINUE IF( NOUNIT ) $ TEMP = TEMP*A( K, K ) B( K, J ) = TEMP END IF 40 CONTINUE 50 CONTINUE ELSE DO 80, J = 1, N DO 70 K = M, 1, -1 IF( B( K, J ).NE.ZERO )THEN TEMP = ALPHA*B( K, J ) B( K, J ) = TEMP IF( NOUNIT ) $ B( K, J ) = B( K, J )*A( K, K ) DO 60, I = K + 1, M B( I, J ) = B( I, J ) + TEMP*A( I, K ) 60 CONTINUE END IF 70 CONTINUE 80 CONTINUE END IF ELSE * * Form B := alpha*A'*B. * IF( UPPER )THEN DO 110, J = 1, N DO 100, I = M, 1, -1 TEMP = B( I, J ) IF( NOUNIT ) $ TEMP = TEMP*A( I, I ) DO 90, K = 1, I - 1 TEMP = TEMP + A( K, I )*B( K, J ) 90 CONTINUE B( I, J ) = ALPHA*TEMP 100 CONTINUE 110 CONTINUE ELSE DO 140, J = 1, N DO 130, I = 1, M TEMP = B( I, J ) IF( NOUNIT ) $ TEMP = TEMP*A( I, I ) DO 120, K = I + 1, M TEMP = TEMP + A( K, I )*B( K, J ) 120 CONTINUE B( I, J ) = ALPHA*TEMP 130 CONTINUE 140 CONTINUE END IF END IF ELSE IF( LBAME( TRANSA, 'N' ) )THEN * * Form B := alpha*B*A. * IF( UPPER )THEN DO 180, J = N, 1, -1 TEMP = ALPHA IF( NOUNIT ) $ TEMP = TEMP*A( J, J ) DO 150, I = 1, M B( I, J ) = TEMP*B( I, J ) 150 CONTINUE DO 170, K = 1, J - 1 IF( A( K, J ).NE.ZERO )THEN TEMP = ALPHA*A( K, J ) DO 160, I = 1, M B( I, J ) = B( I, J ) + TEMP*B( I, K ) 160 CONTINUE END IF 170 CONTINUE 180 CONTINUE ELSE DO 220, J = 1, N TEMP = ALPHA IF( NOUNIT ) $ TEMP = TEMP*A( J, J ) DO 190, I = 1, M B( I, J ) = TEMP*B( I, J ) 190 CONTINUE DO 210, K = J + 1, N IF( A( K, J ).NE.ZERO )THEN TEMP = ALPHA*A( K, J ) DO 200, I = 1, M B( I, J ) = B( I, J ) + TEMP*B( I, K ) 200 CONTINUE END IF 210 CONTINUE 220 CONTINUE END IF ELSE * * Form B := alpha*B*A'. * IF( UPPER )THEN DO 260, K = 1, N DO 240, J = 1, K - 1 IF( A( J, K ).NE.ZERO )THEN TEMP = ALPHA*A( J, K ) DO 230, I = 1, M B( I, J ) = B( I, J ) + TEMP*B( I, K ) 230 CONTINUE END IF 240 CONTINUE TEMP = ALPHA IF( NOUNIT ) $ TEMP = TEMP*A( K, K ) IF( TEMP.NE.ONE )THEN DO 250, I = 1, M B( I, K ) = TEMP*B( I, K ) 250 CONTINUE END IF 260 CONTINUE ELSE DO 300, K = N, 1, -1 DO 280, J = K + 1, N IF( A( J, K ).NE.ZERO )THEN TEMP = ALPHA*A( J, K ) DO 270, I = 1, M B( I, J ) = B( I, J ) + TEMP*B( I, K ) 270 CONTINUE END IF 280 CONTINUE TEMP = ALPHA IF( NOUNIT ) $ TEMP = TEMP*A( K, K ) IF( TEMP.NE.ONE )THEN DO 290, I = 1, M B( I, K ) = TEMP*B( I, K ) 290 CONTINUE END IF 300 CONTINUE END IF END IF END IF * RETURN * * End of DTRMM . * END SUBROUTINE DTRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX ) * .. Scalar Arguments .. INTEGER*4 INCX, LDA, N CHARACTER*1 DIAG, TRANS, UPLO * .. Array Arguments .. DOUBLE PRECISION A( LDA, * ), X( * ) * .. * * Purpose * ======= * * DTRMV performs one of the matrix-vector operations * * x := A*x, or x := A'*x, * * where x is an n element vector and A is an n by n unit, or non-unit, * upper or lower triangular matrix. * * Parameters * ========== * * UPLO - CHARACTER*1. * On entry, UPLO specifies whether the matrix is an upper or * lower triangular matrix as follows: * * UPLO = 'U' or 'u' A is an upper triangular matrix. * * UPLO = 'L' or 'l' A is a lower triangular matrix. * * Unchanged on exit. * * TRANS - CHARACTER*1. * On entry, TRANS specifies the operation to be performed as * follows: * * TRANS = 'N' or 'n' x := A*x. * * TRANS = 'T' or 't' x := A'*x. * * TRANS = 'C' or 'c' x := A'*x. * * Unchanged on exit. * * DIAG - CHARACTER*1. * On entry, DIAG specifies whether or not A is unit * triangular as follows: * * DIAG = 'U' or 'u' A is assumed to be unit triangular. * * DIAG = 'N' or 'n' A is not assumed to be unit * triangular. * * Unchanged on exit. * * N - INTEGER. * On entry, N specifies the order of the matrix A. * N must be at least zero. * Unchanged on exit. * * A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). * Before entry with UPLO = 'U' or 'u', the leading n by n * upper triangular part of the array A must contain the upper * triangular matrix and the strictly lower triangular part of * A is not referenced. * Before entry with UPLO = 'L' or 'l', the leading n by n * lower triangular part of the array A must contain the lower * triangular matrix and the strictly upper triangular part of * A is not referenced. * Note that when DIAG = 'U' or 'u', the diagonal elements of * A are not referenced either, but are assumed to be unity. * Unchanged on exit. * * LDA - INTEGER. * On entry, LDA specifies the first dimension of A as declared * in the calling (sub) program. LDA must be at least * max( 1, n ). * Unchanged on exit. * * X - DOUBLE PRECISION array of dimension at least * ( 1 + ( n - 1 )*abs( INCX ) ). * Before entry, the incremented array X must contain the n * element vector x. On exit, X is overwritten with the * tranformed vector x. * * INCX - INTEGER. * On entry, INCX specifies the increment for the elements of * X. INCX must not be zero. * Unchanged on exit. * * * Level 2 Blas routine. * * -- Written on 22-October-1986. * Jack Dongarra, Argonne National Lab. * Jeremy Du Croz, Nag Central Office. * Sven Hammarling, Nag Central Office. * Richard Hanson, Sandia National Labs. * * * .. Parameters .. DOUBLE PRECISION ZERO PARAMETER ( ZERO = 0.0D+0 ) * .. Local Scalars .. DOUBLE PRECISION TEMP INTEGER*4 I, INFO, IX, J, JX, KX LOGICAL NOUNIT * .. External Functions .. LOGICAL LBAME EXTERNAL LBAME * .. External Subroutines .. EXTERNAL XERBLA * .. Intrinsic Functions .. INTRINSIC MAX * .. * .. Executable Statements .. * * Test the input parameters. * INFO = 0 IF ( .NOT.LBAME( UPLO , 'U' ).AND. $ .NOT.LBAME( UPLO , 'L' ) )THEN INFO = 1 ELSE IF( .NOT.LBAME( TRANS, 'N' ).AND. $ .NOT.LBAME( TRANS, 'T' ).AND. $ .NOT.LBAME( TRANS, 'C' ) )THEN INFO = 2 ELSE IF( .NOT.LBAME( DIAG , 'U' ).AND. $ .NOT.LBAME( DIAG , 'N' ) )THEN INFO = 3 ELSE IF( N.LT.0 )THEN INFO = 4 ELSE IF( LDA.LT.MAX( 1, N ) )THEN INFO = 6 ELSE IF( INCX.EQ.0 )THEN INFO = 8 END IF IF( INFO.NE.0 )THEN CALL XERBLA( 'DTRMV ', INFO ) RETURN END IF * * Quick return if possible. * IF( N.EQ.0 ) $ RETURN * NOUNIT = LBAME( DIAG, 'N' ) * * Set up the start point in X if the increment is not unity. This * will be ( N - 1 )*INCX too small for descending loops. * IF( INCX.LE.0 )THEN KX = 1 - ( N - 1 )*INCX ELSE IF( INCX.NE.1 )THEN KX = 1 END IF * * Start the operations. In this version the elements of A are * accessed sequentially with one pass through A. * IF( LBAME( TRANS, 'N' ) )THEN * * Form x := A*x. * IF( LBAME( UPLO, 'U' ) )THEN IF( INCX.EQ.1 )THEN DO 20, J = 1, N IF( X( J ).NE.ZERO )THEN TEMP = X( J ) DO 10, I = 1, J - 1 X( I ) = X( I ) + TEMP*A( I, J ) 10 CONTINUE IF( NOUNIT ) $ X( J ) = X( J )*A( J, J ) END IF 20 CONTINUE ELSE JX = KX DO 40, J = 1, N IF( X( JX ).NE.ZERO )THEN TEMP = X( JX ) IX = KX DO 30, I = 1, J - 1 X( IX ) = X( IX ) + TEMP*A( I, J ) IX = IX + INCX 30 CONTINUE IF( NOUNIT ) $ X( JX ) = X( JX )*A( J, J ) END IF JX = JX + INCX 40 CONTINUE END IF ELSE IF( INCX.EQ.1 )THEN DO 60, J = N, 1, -1 IF( X( J ).NE.ZERO )THEN TEMP = X( J ) DO 50, I = N, J + 1, -1 X( I ) = X( I ) + TEMP*A( I, J ) 50 CONTINUE IF( NOUNIT ) $ X( J ) = X( J )*A( J, J ) END IF 60 CONTINUE ELSE KX = KX + ( N - 1 )*INCX JX = KX DO 80, J = N, 1, -1 IF( X( JX ).NE.ZERO )THEN TEMP = X( JX ) IX = KX DO 70, I = N, J + 1, -1 X( IX ) = X( IX ) + TEMP*A( I, J ) IX = IX - INCX 70 CONTINUE IF( NOUNIT ) $ X( JX ) = X( JX )*A( J, J ) END IF JX = JX - INCX 80 CONTINUE END IF END IF ELSE * * Form x := A'*x. * IF( LBAME( UPLO, 'U' ) )THEN IF( INCX.EQ.1 )THEN DO 100, J = N, 1, -1 TEMP = X( J ) IF( NOUNIT ) $ TEMP = TEMP*A( J, J ) DO 90, I = J - 1, 1, -1 TEMP = TEMP + A( I, J )*X( I ) 90 CONTINUE X( J ) = TEMP 100 CONTINUE ELSE JX = KX + ( N - 1 )*INCX DO 120, J = N, 1, -1 TEMP = X( JX ) IX = JX IF( NOUNIT ) $ TEMP = TEMP*A( J, J ) DO 110, I = J - 1, 1, -1 IX = IX - INCX TEMP = TEMP + A( I, J )*X( IX ) 110 CONTINUE X( JX ) = TEMP JX = JX - INCX 120 CONTINUE END IF ELSE IF( INCX.EQ.1 )THEN DO 140, J = 1, N TEMP = X( J ) IF( NOUNIT ) $ TEMP = TEMP*A( J, J ) DO 130, I = J + 1, N TEMP = TEMP + A( I, J )*X( I ) 130 CONTINUE X( J ) = TEMP 140 CONTINUE ELSE JX = KX DO 160, J = 1, N TEMP = X( JX ) IX = JX IF( NOUNIT ) $ TEMP = TEMP*A( J, J ) DO 150, I = J + 1, N IX = IX + INCX TEMP = TEMP + A( I, J )*X( IX ) 150 CONTINUE X( JX ) = TEMP JX = JX + INCX 160 CONTINUE END IF END IF END IF * RETURN * * End of DTRMV . * END SUBROUTINE DTRSM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, $ B, LDB ) * .. Scalar Arguments .. CHARACTER*1 SIDE, UPLO, TRANSA, DIAG INTEGER*4 M, N, LDA, LDB DOUBLE PRECISION ALPHA * .. Array Arguments .. DOUBLE PRECISION A( LDA, * ), B( LDB, * ) * .. * * Purpose * ======= * * DTRSM solves one of the matrix equations * * op( A )*X = alpha*B, or X*op( A ) = alpha*B, * * where alpha is a scalar, X and B are m by n matrices, A is a unit, or * non-unit, upper or lower triangular matrix and op( A ) is one of * * op( A ) = A or op( A ) = A'. * * The matrix X is overwritten on B. * * Parameters * ========== * * SIDE - CHARACTER*1. * On entry, SIDE specifies whether op( A ) appears on the left * or right of X as follows: * * SIDE = 'L' or 'l' op( A )*X = alpha*B. * * SIDE = 'R' or 'r' X*op( A ) = alpha*B. * * Unchanged on exit. * * UPLO - CHARACTER*1. * On entry, UPLO specifies whether the matrix A is an upper or * lower triangular matrix as follows: * * UPLO = 'U' or 'u' A is an upper triangular matrix. * * UPLO = 'L' or 'l' A is a lower triangular matrix. * * Unchanged on exit. * * TRANSA - CHARACTER*1. * On entry, TRANSA specifies the form of op( A ) to be used in * the matrix multiplication as follows: * * TRANSA = 'N' or 'n' op( A ) = A. * * TRANSA = 'T' or 't' op( A ) = A'. * * TRANSA = 'C' or 'c' op( A ) = A'. * * Unchanged on exit. * * DIAG - CHARACTER*1. * On entry, DIAG specifies whether or not A is unit triangular * as follows: * * DIAG = 'U' or 'u' A is assumed to be unit triangular. * * DIAG = 'N' or 'n' A is not assumed to be unit * triangular. * * Unchanged on exit. * * M - INTEGER. * On entry, M specifies the number of rows of B. M must be at * least zero. * Unchanged on exit. * * N - INTEGER. * On entry, N specifies the number of columns of B. N must be * at least zero. * Unchanged on exit. * * ALPHA - DOUBLE PRECISION. * On entry, ALPHA specifies the scalar alpha. When alpha is * zero then A is not referenced and B need not be set before * entry. * Unchanged on exit. * * A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m * when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'. * Before entry with UPLO = 'U' or 'u', the leading k by k * upper triangular part of the array A must contain the upper * triangular matrix and the strictly lower triangular part of * A is not referenced. * Before entry with UPLO = 'L' or 'l', the leading k by k * lower triangular part of the array A must contain the lower * triangular matrix and the strictly upper triangular part of * A is not referenced. * Note that when DIAG = 'U' or 'u', the diagonal elements of * A are not referenced either, but are assumed to be unity. * Unchanged on exit. * * LDA - INTEGER. * On entry, LDA specifies the first dimension of A as declared * in the calling (sub) program. When SIDE = 'L' or 'l' then * LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' * then LDA must be at least max( 1, n ). * Unchanged on exit. * * B - DOUBLE PRECISION array of DIMENSION ( LDB, n ). * Before entry, the leading m by n part of the array B must * contain the right-hand side matrix B, and on exit is * overwritten by the solution matrix X. * * LDB - INTEGER. * On entry, LDB specifies the first dimension of B as declared * in the calling (sub) program. LDB must be at least * max( 1, m ). * Unchanged on exit. * * * Level 3 Blas routine. * * * -- Written on 8-February-1989. * Jack Dongarra, Argonne National Laboratory. * Iain Duff, AERE Harwell. * Jeremy Du Croz, Numerical Algorithms Group Ltd. * Sven Hammarling, Numerical Algorithms Group Ltd. * * * .. External Functions .. LOGICAL LBAME EXTERNAL LBAME * .. External Subroutines .. EXTERNAL XERBLA * .. Intrinsic Functions .. INTRINSIC MAX * .. Local Scalars .. LOGICAL LSIDE, NOUNIT, UPPER INTEGER*4 I, INFO, J, K, NROWA DOUBLE PRECISION TEMP * .. Parameters .. DOUBLE PRECISION ONE , ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) * .. * .. Executable Statements .. * * Test the input parameters. * LSIDE = LBAME( SIDE , 'L' ) IF( LSIDE )THEN NROWA = M ELSE NROWA = N END IF NOUNIT = LBAME( DIAG , 'N' ) UPPER = LBAME( UPLO , 'U' ) * INFO = 0 IF( ( .NOT.LSIDE ).AND. $ ( .NOT.LBAME( SIDE , 'R' ) ) )THEN INFO = 1 ELSE IF( ( .NOT.UPPER ).AND. $ ( .NOT.LBAME( UPLO , 'L' ) ) )THEN INFO = 2 ELSE IF( ( .NOT.LBAME( TRANSA, 'N' ) ).AND. $ ( .NOT.LBAME( TRANSA, 'T' ) ).AND. $ ( .NOT.LBAME( TRANSA, 'C' ) ) )THEN INFO = 3 ELSE IF( ( .NOT.LBAME( DIAG , 'U' ) ).AND. $ ( .NOT.LBAME( DIAG , 'N' ) ) )THEN INFO = 4 ELSE IF( M .LT.0 )THEN INFO = 5 ELSE IF( N .LT.0 )THEN INFO = 6 ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN INFO = 9 ELSE IF( LDB.LT.MAX( 1, M ) )THEN INFO = 11 END IF IF( INFO.NE.0 )THEN CALL XERBLA( 'DTRSM ', INFO ) RETURN END IF * * Quick return if possible. * IF( N.EQ.0 ) $ RETURN * * And when alpha.eq.zero. * IF( ALPHA.EQ.ZERO )THEN DO 20, J = 1, N DO 10, I = 1, M B( I, J ) = ZERO 10 CONTINUE 20 CONTINUE RETURN END IF * * Start the operations. * IF( LSIDE )THEN IF( LBAME( TRANSA, 'N' ) )THEN * * Form B := alpha*inv( A )*B. * IF( UPPER )THEN DO 60, J = 1, N IF( ALPHA.NE.ONE )THEN DO 30, I = 1, M B( I, J ) = ALPHA*B( I, J ) 30 CONTINUE END IF DO 50, K = M, 1, -1 IF( B( K, J ).NE.ZERO )THEN IF( NOUNIT ) $ B( K, J ) = B( K, J )/A( K, K ) DO 40, I = 1, K - 1 B( I, J ) = B( I, J ) - B( K, J )*A( I, K ) 40 CONTINUE END IF 50 CONTINUE 60 CONTINUE ELSE DO 100, J = 1, N IF( ALPHA.NE.ONE )THEN DO 70, I = 1, M B( I, J ) = ALPHA*B( I, J ) 70 CONTINUE END IF DO 90 K = 1, M IF( B( K, J ).NE.ZERO )THEN IF( NOUNIT ) $ B( K, J ) = B( K, J )/A( K, K ) DO 80, I = K + 1, M B( I, J ) = B( I, J ) - B( K, J )*A( I, K ) 80 CONTINUE END IF 90 CONTINUE 100 CONTINUE END IF ELSE * * Form B := alpha*inv( A' )*B. * IF( UPPER )THEN DO 130, J = 1, N DO 120, I = 1, M TEMP = ALPHA*B( I, J ) DO 110, K = 1, I - 1 TEMP = TEMP - A( K, I )*B( K, J ) 110 CONTINUE IF( NOUNIT ) $ TEMP = TEMP/A( I, I ) B( I, J ) = TEMP 120 CONTINUE 130 CONTINUE ELSE DO 160, J = 1, N DO 150, I = M, 1, -1 TEMP = ALPHA*B( I, J ) DO 140, K = I + 1, M TEMP = TEMP - A( K, I )*B( K, J ) 140 CONTINUE IF( NOUNIT ) $ TEMP = TEMP/A( I, I ) B( I, J ) = TEMP 150 CONTINUE 160 CONTINUE END IF END IF ELSE IF( LBAME( TRANSA, 'N' ) )THEN * * Form B := alpha*B*inv( A ). * IF( UPPER )THEN DO 210, J = 1, N IF( ALPHA.NE.ONE )THEN DO 170, I = 1, M B( I, J ) = ALPHA*B( I, J ) 170 CONTINUE END IF DO 190, K = 1, J - 1 IF( A( K, J ).NE.ZERO )THEN DO 180, I = 1, M B( I, J ) = B( I, J ) - A( K, J )*B( I, K ) 180 CONTINUE END IF 190 CONTINUE IF( NOUNIT )THEN TEMP = ONE/A( J, J ) DO 200, I = 1, M B( I, J ) = TEMP*B( I, J ) 200 CONTINUE END IF 210 CONTINUE ELSE DO 260, J = N, 1, -1 IF( ALPHA.NE.ONE )THEN DO 220, I = 1, M B( I, J ) = ALPHA*B( I, J ) 220 CONTINUE END IF DO 240, K = J + 1, N IF( A( K, J ).NE.ZERO )THEN DO 230, I = 1, M B( I, J ) = B( I, J ) - A( K, J )*B( I, K ) 230 CONTINUE END IF 240 CONTINUE IF( NOUNIT )THEN TEMP = ONE/A( J, J ) DO 250, I = 1, M B( I, J ) = TEMP*B( I, J ) 250 CONTINUE END IF 260 CONTINUE END IF ELSE * * Form B := alpha*B*inv( A' ). * IF( UPPER )THEN DO 310, K = N, 1, -1 IF( NOUNIT )THEN TEMP = ONE/A( K, K ) DO 270, I = 1, M B( I, K ) = TEMP*B( I, K ) 270 CONTINUE END IF DO 290, J = 1, K - 1 IF( A( J, K ).NE.ZERO )THEN TEMP = A( J, K ) DO 280, I = 1, M B( I, J ) = B( I, J ) - TEMP*B( I, K ) 280 CONTINUE END IF 290 CONTINUE IF( ALPHA.NE.ONE )THEN DO 300, I = 1, M B( I, K ) = ALPHA*B( I, K ) 300 CONTINUE END IF 310 CONTINUE ELSE DO 360, K = 1, N IF( NOUNIT )THEN TEMP = ONE/A( K, K ) DO 320, I = 1, M B( I, K ) = TEMP*B( I, K ) 320 CONTINUE END IF DO 340, J = K + 1, N IF( A( J, K ).NE.ZERO )THEN TEMP = A( J, K ) DO 330, I = 1, M B( I, J ) = B( I, J ) - TEMP*B( I, K ) 330 CONTINUE END IF 340 CONTINUE IF( ALPHA.NE.ONE )THEN DO 350, I = 1, M B( I, K ) = ALPHA*B( I, K ) 350 CONTINUE END IF 360 CONTINUE END IF END IF END IF * RETURN * * End of DTRSM . * END c ooooooooooooooo SUBROUTINE DGER ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA ) * .. Scalar Arguments .. real*8 ALPHA INTEGER*4 INCX, INCY, LDA, M, N * .. Array Arguments .. real*8 A( LDA, * ), X( * ), Y( * ) * .. * * Purpose * ======= * * DGER performs the rank 1 operation * * A := alpha*x*y' + A, * * where alpha is a scalar, x is an m element vector, y is an n element * vector and A is an m by n matrix. * * Parameters * ========== * * M - INTEGER. * On entry, M specifies the number of rows of the matrix A. * M must be at least zero. * Unchanged on exit. * * N - INTEGER. * On entry, N specifies the number of columns of the matrix A. * N must be at least zero. * Unchanged on exit. * * ALPHA - real*8. * On entry, ALPHA specifies the scalar alpha. * Unchanged on exit. * * X - real*8 array of dimension at least * ( 1 + ( m - 1 )*abs( INCX ) ). * Before entry, the incremented array X must contain the m * element vector x. * Unchanged on exit. * * INCX - INTEGER. * On entry, INCX specifies the increment for the elements of * X. INCX must not be zero. * Unchanged on exit. * * Y - real*8 array of dimension at least * ( 1 + ( n - 1 )*abs( INCY ) ). * Before entry, the incremented array Y must contain the n * element vector y. * Unchanged on exit. * * INCY - INTEGER. * On entry, INCY specifies the increment for the elements of * Y. INCY must not be zero. * Unchanged on exit. * * A - real*8 array of DIMENSION ( LDA, n ). * Before entry, the leading m by n part of the array A must * contain the matrix of coefficients. On exit, A is * overwritten by the updated matrix. * * LDA - INTEGER. * On entry, LDA specifies the first dimension of A as declared * in the calling (sub) program. LDA must be at least * max( 1, m ). * Unchanged on exit. * * * Level 2 Blas routine. * * -- Written on 22-October-1986. * Jack Dongarra, Argonne National Lab. * Jeremy Du Croz, Nag Central Office. * Sven Hammarling, Nag Central Office. * Richard Hanson, Sandia National Labs. * * * .. Parameters .. real*8 ZERO PARAMETER ( ZERO = 0.0D+0 ) * .. Local Scalars .. real*8 TEMP INTEGER*4 I, INFO, IX, J, JY, KX * .. External Subroutines .. EXTERNAL XERBLA * .. Intrinsic Functions .. INTRINSIC MAX * .. * .. Executable Statements .. * * Test the input parameters. * INFO = 0 IF ( M.LT.0 )THEN INFO = 1 ELSE IF( N.LT.0 )THEN INFO = 2 ELSE IF( INCX.EQ.0 )THEN INFO = 5 ELSE IF( INCY.EQ.0 )THEN INFO = 7 ELSE IF( LDA.LT.MAX( 1, M ) )THEN INFO = 9 END IF IF( INFO.NE.0 )THEN CALL XERBLA( 'DGER ', INFO ) RETURN END IF * * Quick return if possible. * IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) ) $ RETURN * * Start the operations. In this version the elements of A are * accessed sequentially with one pass through A. * IF( INCY.GT.0 )THEN JY = 1 ELSE JY = 1 - ( N - 1 )*INCY END IF IF( INCX.EQ.1 )THEN DO 20, J = 1, N IF( Y( JY ).NE.ZERO )THEN TEMP = ALPHA*Y( JY ) DO 10, I = 1, M A( I, J ) = A( I, J ) + X( I )*TEMP 10 CONTINUE END IF JY = JY + INCY 20 CONTINUE ELSE IF( INCX.GT.0 )THEN KX = 1 ELSE KX = 1 - ( M - 1 )*INCX END IF DO 40, J = 1, N IF( Y( JY ).NE.ZERO )THEN TEMP = ALPHA*Y( JY ) IX = KX DO 30, I = 1, M A( I, J ) = A( I, J ) + X( IX )*TEMP IX = IX + INCX 30 CONTINUE END IF JY = JY + INCY 40 CONTINUE END IF * RETURN * * End of DGER . * END SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO ) * * -- LAPACK routine (version 3.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * June 30, 1992 * * .. Scalar Arguments .. INTEGER*4 INFO, LDA, M, N * .. * .. Array Arguments .. INTEGER*4 IPIV( * ) real*8 A( LDA, * ) * .. * * Purpose * ======= * * DGETF2 computes an LU factorization of a general m-by-n matrix A * using partial pivoting with row interchanges. * * The factorization has the form * A = P * L * U * where P is a permutation matrix, L is lower triangular with unit * diagonal elements (lower trapezoidal if m > n), and U is upper * triangular (upper trapezoidal if m < n). * * This is the right-looking Level 2 BLAS version of the algorithm. * * Arguments * ========= * * M (input) INTEGER * The number of rows of the matrix A. M >= 0. * * N (input) INTEGER * The number of columns of the matrix A. N >= 0. * * A (input/output) real*8 array, dimension (LDA,N) * On entry, the m by n matrix to be factored. * On exit, the factors L and U from the factorization * A = P*L*U; the unit diagonal elements of L are not stored. * * LDA (input) INTEGER * The leading dimension of the array A. LDA >= max(1,M). * * IPIV (output) INTEGER*4 array, dimension (min(M,N)) * The pivot indices; for 1 <= i <= min(M,N), row i of the * matrix was interchanged with row IPIV(i). * * INFO (output) INTEGER * = 0: successful exit * < 0: if INFO = -k, the k-th argument had an illegal value * > 0: if INFO = k, U(k,k) is exactly zero. The factorization * has been completed, but the factor U is exactly * singular, and division by zero will occur if it is used * to solve a system of equations. * * ===================================================================== * * .. Parameters .. real*8 ONE, ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) * .. * .. Local Scalars .. INTEGER*4 J, JP * .. * .. External Functions .. INTEGER*4 IDAMAX EXTERNAL IDAMAX * .. * .. External Subroutines .. EXTERNAL DGER, DSCAL, DSWAP, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. * .. Executable Statements .. * * Test the input parameters. * INFO = 0 IF( M.LT.0 ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DGETF2', -INFO ) RETURN END IF * * Quick return if possible * IF( M.EQ.0 .OR. N.EQ.0 ) $ RETURN * DO 10 J = 1, MIN( M, N ) * * Find pivot and test for singularity. * JP = J - 1 + IDAMAX( M-J+1, A( J, J ), 1 ) IPIV( J ) = JP IF( A( JP, J ).NE.ZERO ) THEN * * Apply the interchange to columns 1:N. * IF( JP.NE.J ) $ CALL DSWAP( N, A( J, 1 ), LDA, A( JP, 1 ), LDA ) * * Compute elements J+1:M of J-th column. * IF( J.LT.M ) $ CALL DSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 ) * ELSE IF( INFO.EQ.0 ) THEN * INFO = J END IF * IF( J.LT.MIN( M, N ) ) THEN * * Update trailing submatrix. * CALL DGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), LDA, $ A( J+1, J+1 ), LDA ) END IF 10 CONTINUE RETURN * * End of DGETF2 * END SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO ) * * -- LAPACK routine (version 3.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * March 31, 1993 * * .. Scalar Arguments .. INTEGER*4 INFO, LDA, M, N * .. * .. Array Arguments .. INTEGER*4 IPIV( * ) real*8 A( LDA, * ) * .. * * Purpose * ======= * * DGETRF computes an LU factorization of a general M-by-N matrix A * using partial pivoting with row interchanges. * * The factorization has the form * A = P * L * U * where P is a permutation matrix, L is lower triangular with unit * diagonal elements (lower trapezoidal if m > n), and U is upper * triangular (upper trapezoidal if m < n). * * This is the right-looking Level 3 BLAS version of the algorithm. * * Arguments * ========= * * M (input) INT * The number of rows of the matrix A. M >= 0. * * N (input) INT * The number of columns of the matrix A. N >= 0. * * A (input/output) real*8 array, dimension (LDA,N) * On entry, the M-by-N matrix to be factored. * On exit, the factors L and U from the factorization * A = P*L*U; the unit diagonal elements of L are not stored. * * LDA (input) INT * The leading dimension of the array A. LDA >= max(1,M). * * IPIV (output) INTEGER*4 array, dimension (min(M,N)) * The pivot indices; for 1 <= i <= min(M,N), row i of the * matrix was interchanged with row IPIV(i). * * INFO (output) INTEGER * = 0: successful exit * < 0: if INFO = -i, the i-th argument had an illegal value * > 0: if INFO = i, U(i,i) is exactly zero. The factorization * has been completed, but the factor U is exactly * singular, and division by zero will occur if it is used * to solve a system of equations. * * ===================================================================== * * .. Parameters .. real*8 ONE PARAMETER ( ONE = 1.0D+0 ) * .. * .. Local Scalars .. INTEGER*4 I, IINFO, J, JB, NB * .. * .. External Subroutines .. EXTERNAL DGEMM, DGETF2, DLASWP, DTRSM, XERBLA * .. * .. External Functions .. INTEGER*4 ILAENV EXTERNAL ILAENV * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. * .. Executable Statements .. * * Test the input parameters. * INFO = 0 IF( M.LT.0 ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DGETRF', -INFO ) RETURN END IF * * Quick return if possible * IF( M.EQ.0 .OR. N.EQ.0 ) $ RETURN * * Determine the block size for this environment. * NB = ILAENV( 1, 'DGETRF', ' ', M, N, -1, -1 ) IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN * * Use unblocked code. * CALL DGETF2( M, N, A, LDA, IPIV, INFO ) ELSE * * Use blocked code. * DO 20 J = 1, MIN( M, N ), NB JB = MIN( MIN( M, N )-J+1, NB ) * * Factor diagonal and subdiagonal blocks and test for exact * singularity. * CALL DGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO ) * * Adjust INFO and the pivot indices. * IF( INFO.EQ.0 .AND. IINFO.GT.0 ) $ INFO = IINFO + J - 1 DO 10 I = J, MIN( M, J+JB-1 ) IPIV( I ) = J - 1 + IPIV( I ) 10 CONTINUE * * Apply interchanges to columns 1:J-1. * CALL DLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 ) * IF( J+JB.LE.N ) THEN * * Apply interchanges to columns J+JB:N. * CALL DLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1, $ IPIV, 1 ) * * Compute block row of U. * CALL DTRSM( 'L', 'L', 'N', 'U', JB, $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ), $ LDA ) IF( J+JB.LE.M ) THEN * * Update trailing submatrix. * CALL DGEMM( 'N', 'N', M-J-JB+1, $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA, $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ), $ LDA ) END IF END IF 20 CONTINUE END IF RETURN * * End of DGETRF * END SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX ) * * -- LAPACK auxiliary routine (version 3.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * June 30, 1999 * * .. Scalar Arguments .. INTEGER*4 INCX, K1, K2, LDA, N * .. * .. Array Arguments .. INTEGER*4 IPIV( * ) real*8 A( LDA, * ) * .. * * Purpose * ======= * * DLASWP performs a series of row interchanges on the matrix A. * One row interchange is initiated for each of rows K1 through K2 of A. * * Arguments * ========= * * N (input) INTEGER * The number of columns of the matrix A. * * A (input/output) real*8 array, dimension (LDA,N) * On entry, the matrix of column dimension N to which the row * interchanges will be applied. * On exit, the permuted matrix. * * LDA (input) INTEGER * The leading dimension of the array A. * * K1 (input) INTEGER * The first element of IPIV for which a row interchange will * be done. * * K2 (input) INTEGER * The last element of IPIV for which a row interchange will * be done. * * IPIV (input) INTEGER*4 array, dimension (M*abs(INCX)) * The vector of pivot indices. Only the elements in positions * K1 through K2 of IPIV are accessed. * IPIV(K) = L implies rows K and L are to be interchanged. * * INCX (input) INTEGER * The increment between successive values of IPIV. If IPIV * is negative, the pivots are applied in reverse order. * * Further Details * =============== * * Modified by * R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA * * ===================================================================== * * .. Local Scalars .. INTEGER*4 I, I1, I2, INC, IP, IX, IX0, J, K, N32 real*8 TEMP * .. * .. Executable Statements .. * * Interchange row I with row IPIV(I) for each of rows K1 through K2. * IF( INCX.GT.0 ) THEN IX0 = K1 I1 = K1 I2 = K2 INC = 1 ELSE IF( INCX.LT.0 ) THEN IX0 = 1 + ( 1-K2 )*INCX I1 = K2 I2 = K1 INC = -1 ELSE RETURN END IF * N32 = ( N / 32 )*32 IF( N32.NE.0 ) THEN DO 30 J = 1, N32, 32 IX = IX0 DO 20 I = I1, I2, INC IP = IPIV( IX ) IF( IP.NE.I ) THEN DO 10 K = J, J + 31 TEMP = A( I, K ) A( I, K ) = A( IP, K ) A( IP, K ) = TEMP 10 CONTINUE END IF IX = IX + INCX 20 CONTINUE 30 CONTINUE END IF IF( N32.NE.N ) THEN N32 = N32 + 1 IX = IX0 DO 50 I = I1, I2, INC IP = IPIV( IX ) IF( IP.NE.I ) THEN DO 40 K = N32, N TEMP = A( I, K ) A( I, K ) = A( IP, K ) A( IP, K ) = TEMP 40 CONTINUE END IF IX = IX + INCX 50 CONTINUE END IF * RETURN * * End of DLASWP * END subroutine dscal(n,da,dx,incx) c c scales a vector by a constant. c uses unrolled loops for increment equal to one. c jack dongarra, linpack, 3/11/78. c modified 3/93 to return if incx .le. 0. c modified 12/3/93, array(1) declarations changed to array(*) c real*8 da,dx(*) integer*4 i,incx,m,mp1,n,nincx c if( n.le.0 .or. incx.le.0 )return if(incx.eq.1)go to 20 c c code for increment not equal to 1 c nincx = n*incx do 10 i = 1,nincx,incx dx(i) = da*dx(i) 10 continue return c c code for increment equal to 1 c c c clean-up loop c 20 m = mod(n,5) if( m .eq. 0 ) go to 40 do 30 i = 1,m dx(i) = da*dx(i) 30 continue if( n .lt. 5 ) return 40 mp1 = m + 1 do 50 i = mp1,n,5 dx(i) = da*dx(i) dx(i + 1) = da*dx(i + 1) dx(i + 2) = da*dx(i + 2) dx(i + 3) = da*dx(i + 3) dx(i + 4) = da*dx(i + 4) 50 continue return end integer*4 function idamax(n,dx,incx) c c finds the index of element having max. absolute value. c jack dongarra, linpack, 3/11/78. c modified 3/93 to return if incx .le. 0. c modified 12/3/93, array(1) declarations changed to array(*) c real*8 dx(*),dmax integer*4 i,incx,ix,n c idamax = 0 if( n.lt.1 .or. incx.le.0 ) return idamax = 1 if(n.eq.1)return if(incx.eq.1)go to 20 c c code for increment not equal to 1 c ix = 1 dmax = dabs(dx(1)) ix = ix + incx do 10 i = 2,n if(dabs(dx(ix)).le.dmax) go to 5 idamax = i dmax = dabs(dx(ix)) 5 ix = ix + incx 10 continue return c c code for increment equal to 1 c 20 dmax = dabs(dx(1)) do 30 i = 2,n if(dabs(dx(i)).le.dmax) go to 30 idamax = i dmax = dabs(dx(i)) 30 continue return end INTEGER*4 FUNCTION IEEECK( ISPEC, ZERO, ONE ) * * -- LAPACK auxiliary routine (version 3.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * June 30, 1998 * * .. Scalar Arguments .. INTEGER*4 ISPEC REAL*8 ONE, ZERO * .. * * Purpose * ======= * * IEEECK is called from the ILAENV to verify that Infinity and * possibly NaN arithmetic is safe (i.e. will not trap). * * Arguments * ========= * * ISPEC (input) INTEGER * Specifies whether to test just for inifinity arithmetic * or whether to test for infinity and NaN arithmetic. * = 0: Verify infinity arithmetic only. * = 1: Verify infinity and NaN arithmetic. * * ZERO (input) REAL * Must contain the value 0.0 * This is passed to prevent the compiler from optimizing * away this code. * * ONE (input) REAL * Must contain the value 1.0 * This is passed to prevent the compiler from optimizing * away this code. * * RETURN VALUE: INTEGER * = 0: Arithmetic failed to produce the correct answers * = 1: Arithmetic produced the correct answers * * .. Local Scalars .. REAL*8 NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF, $ NEGZRO, NEWZRO, POSINF * .. * .. Executable Statements .. IEEECK = 1 * POSINF = ONE / ZERO IF( POSINF.LE.ONE ) THEN IEEECK = 0 RETURN END IF * NEGINF = -ONE / ZERO IF( NEGINF.GE.ZERO ) THEN IEEECK = 0 RETURN END IF * NEGZRO = ONE / ( NEGINF+ONE ) IF( NEGZRO.NE.ZERO ) THEN IEEECK = 0 RETURN END IF * NEGINF = ONE / NEGZRO IF( NEGINF.GE.ZERO ) THEN IEEECK = 0 RETURN END IF * NEWZRO = NEGZRO + ZERO IF( NEWZRO.NE.ZERO ) THEN IEEECK = 0 RETURN END IF * POSINF = ONE / NEWZRO IF( POSINF.LE.ONE ) THEN IEEECK = 0 RETURN END IF * NEGINF = NEGINF*POSINF IF( NEGINF.GE.ZERO ) THEN IEEECK = 0 RETURN END IF * POSINF = POSINF*POSINF IF( POSINF.LE.ONE ) THEN IEEECK = 0 RETURN END IF * * * * * Return if we were only asked to check infinity arithmetic * IF( ISPEC.EQ.0 ) $ RETURN * NAN1 = POSINF + NEGINF * NAN2 = POSINF / NEGINF * NAN3 = POSINF / POSINF * NAN4 = POSINF*ZERO * NAN5 = NEGINF*NEGZRO * NAN6 = NAN5*0.0d0 * IF( NAN1.EQ.NAN1 ) THEN IEEECK = 0 RETURN END IF * IF( NAN2.EQ.NAN2 ) THEN IEEECK = 0 RETURN END IF * IF( NAN3.EQ.NAN3 ) THEN IEEECK = 0 RETURN END IF * IF( NAN4.EQ.NAN4 ) THEN IEEECK = 0 RETURN END IF * IF( NAN5.EQ.NAN5 ) THEN IEEECK = 0 RETURN END IF * IF( NAN6.EQ.NAN6 ) THEN IEEECK = 0 RETURN END IF * RETURN END INTEGER*4 FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, $ N4 ) * * -- LAPACK auxiliary routine (version 3.0) -- * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., * Courant Institute, Argonne National Lab, and Rice University * June 30, 1999 * * .. Scalar Arguments .. CHARACTER*( * ) NAME, OPTS INTEGER*4 ISPEC, N1, N2, N3, N4 * .. * * Purpose * ======= * * ILAENV is called from the LAPACK routines to choose problem-dependent * parameters for the local environment. See ISPEC for a description of * the parameters. * * This version provides a set of parameters which should give good, * but not optimal, performance on many of the currently available * computers. Users are encouraged to modify this subroutine to set * the tuning parameters for their particular machine using the option * and problem size information in the arguments. * * This routine will not function correctly if it is converted to all * lower case. Converting it to all upper case is allowed. * * Arguments * ========= * * ISPEC (input) INTEGER * Specifies the parameter to be returned as the value of * ILAENV. * = 1: the optimal blocksize; if this value is 1, an unblocked * algorithm will give the best performance. * = 2: the minimum block size for which the block routine * should be used; if the usable block size is less than * this value, an unblocked routine should be used. * = 3: the crossover point (in a block routine, for N less * than this value, an unblocked routine should be used) * = 4: the number of shifts, used in the nonsymmetric * eigenvalue routines * = 5: the minimum column dimension for blocking to be used; * rectangular blocks must have dimension at least k by m, * where k is given by ILAENV(2,...) and m by ILAENV(5,...) * = 6: the crossover point for the SVD (when reducing an m by n * matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds * this value, a QR factorization is used first to reduce * the matrix to a triangular form.) * = 7: the number of processors * = 8: the crossover point for the multishift QR and QZ methods * for nonsymmetric eigenvalue problems. * = 9: maximum size of the subproblems at the bottom of the * computation tree in the divide-and-conquer algorithm * (used by xGELSD and xGESDD) * =10: ieee NaN arithmetic can be trusted not to trap * =11: infinity arithmetic can be trusted not to trap * * NAME (input) CHARACTER*(*) * The name of the calling subroutine, in either upper case or * lower case. * * OPTS (input) CHARACTER*(*) * The character options to the subroutine NAME, concatenated * into a single character string. For example, UPLO = 'U', * TRANS = 'T', and DIAG = 'N' for a triangular routine would * be specified as OPTS = 'UTN'. * * N1 (input) INTEGER * N2 (input) INTEGER * N3 (input) INTEGER * N4 (input) INTEGER * Problem dimensions for the subroutine NAME; these may not all * be required. * * (ILAENV) (output) INTEGER * >= 0: the value of the parameter specified by ISPEC * < 0: if ILAENV = -k, the k-th argument had an illegal value. * * Further Details * =============== * * The following conventions have been used when calling ILAENV from the * LAPACK routines: * 1) OPTS is a concatenation of all of the character options to * subroutine NAME, in the same order that they appear in the * argument list for NAME, even if they are not used in determining * the value of the parameter specified by ISPEC. * 2) The problem dimensions N1, N2, N3, N4 are specified in the order * that they appear in the argument list for NAME. N1 is used * first, N2 second, and so on, and unused problem dimensions are * passed a value of -1. * 3) The parameter value returned by ILAENV is checked for validity in * the calling subroutine. For example, ILAENV is used to retrieve * the optimal blocksize for STRTRI as follows: * * NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 ) * IF( NB.LE.1 ) NB = MAX( 1, N ) * * ===================================================================== * * .. Local Scalars .. LOGICAL CNAME, SNAME CHARACTER*1 C1 CHARACTER*2 C2, C4 CHARACTER*3 C3 CHARACTER*6 SUBNAM INTEGER*4 I, IC, IZ, NB, NBMIN, NX * .. * .. Intrinsic Functions .. INTRINSIC CHAR, ICHAR, INT, MIN, REAL * .. * .. External Functions .. INTEGER*4 IEEECK EXTERNAL IEEECK * .. * .. Executable Statements .. * GO TO ( 100, 100, 100, 400, 500, 600, 700, 800, 900, 1000, $ 1100 ) ISPEC * * Invalid value for ISPEC * ILAENV = -1 RETURN * 100 CONTINUE * * Convert NAME to upper case if the first character is lower case. * ILAENV = 1 SUBNAM = NAME IC = ICHAR( SUBNAM( 1:1 ) ) IZ = ICHAR( 'Z' ) IF( IZ.EQ.90 .OR. IZ.EQ.122 ) THEN * * ASCII character set * IF( IC.GE.97 .AND. IC.LE.122 ) THEN SUBNAM( 1:1 ) = CHAR( IC-32 ) DO 10 I = 2, 6 IC = ICHAR( SUBNAM( I:I ) ) IF( IC.GE.97 .AND. IC.LE.122 ) $ SUBNAM( I:I ) = CHAR( IC-32 ) 10 CONTINUE END IF * ELSE IF( IZ.EQ.233 .OR. IZ.EQ.169 ) THEN * * EBCDIC character set * IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR. $ ( IC.GE.145 .AND. IC.LE.153 ) .OR. $ ( IC.GE.162 .AND. IC.LE.169 ) ) THEN SUBNAM( 1:1 ) = CHAR( IC+64 ) DO 20 I = 2, 6 IC = ICHAR( SUBNAM( I:I ) ) IF( ( IC.GE.129 .AND. IC.LE.137 ) .OR. $ ( IC.GE.145 .AND. IC.LE.153 ) .OR. $ ( IC.GE.162 .AND. IC.LE.169 ) ) $ SUBNAM( I:I ) = CHAR( IC+64 ) 20 CONTINUE END IF * ELSE IF( IZ.EQ.218 .OR. IZ.EQ.250 ) THEN * * Prime machines: ASCII+128 * IF( IC.GE.225 .AND. IC.LE.250 ) THEN SUBNAM( 1:1 ) = CHAR( IC-32 ) DO 30 I = 2, 6 IC = ICHAR( SUBNAM( I:I ) ) IF( IC.GE.225 .AND. IC.LE.250 ) $ SUBNAM( I:I ) = CHAR( IC-32 ) 30 CONTINUE END IF END IF * C1 = SUBNAM( 1:1 ) SNAME = C1.EQ.'S' .OR. C1.EQ.'D' CNAME = C1.EQ.'C' .OR. C1.EQ.'Z' IF( .NOT.( CNAME .OR. SNAME ) ) $ RETURN C2 = SUBNAM( 2:3 ) C3 = SUBNAM( 4:6 ) C4 = C3( 2:3 ) * GO TO ( 110, 200, 300 ) ISPEC * 110 CONTINUE * * ISPEC = 1: block size * * In these examples, separate code is provided for setting NB for * real and complex. We assume that NB will take the same value in * single or real*8. * NB = 1 * IF( C2.EQ.'GE' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN NB = 64 ELSE NB = 64 END IF ELSE IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. $ C3.EQ.'QLF' ) THEN IF( SNAME ) THEN NB = 32 ELSE NB = 32 END IF ELSE IF( C3.EQ.'HRD' ) THEN IF( SNAME ) THEN NB = 32 ELSE NB = 32 END IF ELSE IF( C3.EQ.'BRD' ) THEN IF( SNAME ) THEN NB = 32 ELSE NB = 32 END IF ELSE IF( C3.EQ.'TRI' ) THEN IF( SNAME ) THEN NB = 64 ELSE NB = 64 END IF END IF ELSE IF( C2.EQ.'PO' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN NB = 64 ELSE NB = 64 END IF END IF ELSE IF( C2.EQ.'SY' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN NB = 64 ELSE NB = 64 END IF ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN NB = 32 ELSE IF( SNAME .AND. C3.EQ.'GST' ) THEN NB = 64 END IF ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN IF( C3.EQ.'TRF' ) THEN NB = 64 ELSE IF( C3.EQ.'TRD' ) THEN NB = 32 ELSE IF( C3.EQ.'GST' ) THEN NB = 64 END IF ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN IF( C3( 1:1 ).EQ.'G' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NB = 32 END IF ELSE IF( C3( 1:1 ).EQ.'M' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NB = 32 END IF END IF ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN IF( C3( 1:1 ).EQ.'G' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NB = 32 END IF ELSE IF( C3( 1:1 ).EQ.'M' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NB = 32 END IF END IF ELSE IF( C2.EQ.'GB' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN IF( N4.LE.64 ) THEN NB = 1 ELSE NB = 32 END IF ELSE IF( N4.LE.64 ) THEN NB = 1 ELSE NB = 32 END IF END IF END IF ELSE IF( C2.EQ.'PB' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN IF( N2.LE.64 ) THEN NB = 1 ELSE NB = 32 END IF ELSE IF( N2.LE.64 ) THEN NB = 1 ELSE NB = 32 END IF END IF END IF ELSE IF( C2.EQ.'TR' ) THEN IF( C3.EQ.'TRI' ) THEN IF( SNAME ) THEN NB = 64 ELSE NB = 64 END IF END IF ELSE IF( C2.EQ.'LA' ) THEN IF( C3.EQ.'UUM' ) THEN IF( SNAME ) THEN NB = 64 ELSE NB = 64 END IF END IF ELSE IF( SNAME .AND. C2.EQ.'ST' ) THEN IF( C3.EQ.'EBZ' ) THEN NB = 1 END IF END IF ILAENV = NB RETURN * 200 CONTINUE * * ISPEC = 2: minimum block size * NBMIN = 2 IF( C2.EQ.'GE' ) THEN IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. $ C3.EQ.'QLF' ) THEN IF( SNAME ) THEN NBMIN = 2 ELSE NBMIN = 2 END IF ELSE IF( C3.EQ.'HRD' ) THEN IF( SNAME ) THEN NBMIN = 2 ELSE NBMIN = 2 END IF ELSE IF( C3.EQ.'BRD' ) THEN IF( SNAME ) THEN NBMIN = 2 ELSE NBMIN = 2 END IF ELSE IF( C3.EQ.'TRI' ) THEN IF( SNAME ) THEN NBMIN = 2 ELSE NBMIN = 2 END IF END IF ELSE IF( C2.EQ.'SY' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN NBMIN = 8 ELSE NBMIN = 8 END IF ELSE IF( SNAME .AND. C3.EQ.'TRD' ) THEN NBMIN = 2 END IF ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN IF( C3.EQ.'TRD' ) THEN NBMIN = 2 END IF ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN IF( C3( 1:1 ).EQ.'G' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NBMIN = 2 END IF ELSE IF( C3( 1:1 ).EQ.'M' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NBMIN = 2 END IF END IF ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN IF( C3( 1:1 ).EQ.'G' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NBMIN = 2 END IF ELSE IF( C3( 1:1 ).EQ.'M' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NBMIN = 2 END IF END IF END IF ILAENV = NBMIN RETURN * 300 CONTINUE * * ISPEC = 3: crossover point * NX = 0 IF( C2.EQ.'GE' ) THEN IF( C3.EQ.'QRF' .OR. C3.EQ.'RQF' .OR. C3.EQ.'LQF' .OR. $ C3.EQ.'QLF' ) THEN IF( SNAME ) THEN NX = 128 ELSE NX = 128 END IF ELSE IF( C3.EQ.'HRD' ) THEN IF( SNAME ) THEN NX = 128 ELSE NX = 128 END IF ELSE IF( C3.EQ.'BRD' ) THEN IF( SNAME ) THEN NX = 128 ELSE NX = 128 END IF END IF ELSE IF( C2.EQ.'SY' ) THEN IF( SNAME .AND. C3.EQ.'TRD' ) THEN NX = 32 END IF ELSE IF( CNAME .AND. C2.EQ.'HE' ) THEN IF( C3.EQ.'TRD' ) THEN NX = 32 END IF ELSE IF( SNAME .AND. C2.EQ.'OR' ) THEN IF( C3( 1:1 ).EQ.'G' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NX = 128 END IF END IF ELSE IF( CNAME .AND. C2.EQ.'UN' ) THEN IF( C3( 1:1 ).EQ.'G' ) THEN IF( C4.EQ.'QR' .OR. C4.EQ.'RQ' .OR. C4.EQ.'LQ' .OR. $ C4.EQ.'QL' .OR. C4.EQ.'HR' .OR. C4.EQ.'TR' .OR. $ C4.EQ.'BR' ) THEN NX = 128 END IF END IF END IF ILAENV = NX RETURN * 400 CONTINUE * * ISPEC = 4: number of shifts (used by xHSEQR) * ILAENV = 6 RETURN * 500 CONTINUE * * ISPEC = 5: minimum column dimension (not used) * ILAENV = 2 RETURN * 600 CONTINUE * * ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD) * ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 ) RETURN * 700 CONTINUE * * ISPEC = 7: number of processors (not used) * ILAENV = 1 RETURN * 800 CONTINUE * * ISPEC = 8: crossover point for multishift (used by xHSEQR) * ILAENV = 50 RETURN * 900 CONTINUE * * ISPEC = 9: maximum size of the subproblems at the bottom of the * computation tree in the divide-and-conquer algorithm * (used by xGELSD and xGESDD) * ILAENV = 25 RETURN * 1000 CONTINUE * * ISPEC = 10: ieee NaN arithmetic can be trusted not to trap * C ILAENV = 0 ILAENV = 1 IF( ILAENV.EQ.1 ) THEN ILAENV = IEEECK( 0, 0.0D0, 1.0D0 ) END IF RETURN * 1100 CONTINUE * * ISPEC = 11: infinity arithmetic can be trusted not to trap * C ILAENV = 0 ILAENV = 1 IF( ILAENV.EQ.1 ) THEN ILAENV = IEEECK( 1, 0.0D0, 1.0D0 ) END IF RETURN * * End of ILAENV * END subroutine gen_oh(code, num, x, y, z, w, a, b, v) implicit logical(a-z) double precision x(*),y(*),z(*),w(*) double precision a,b,v integer code integer num double precision c chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated from C to fortran77 by hand. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd cvw cvw Given a point on a sphere (specified by a and b), generate all cvw the equivalent points under Oh symmetry, making grid points with cvw weight v. cvw The variable num is increased by the number of different points cvw generated. cvw cvw Depending on code, there are 6...48 different but equivalent cvw points. cvw cvw code=1: (0,0,1) etc ( 6 points) cvw code=2: (0,a,a) etc, a=1/sqrt(2) ( 12 points) cvw code=3: (a,a,a) etc, a=1/sqrt(3) ( 8 points) cvw code=4: (a,a,b) etc, b=sqrt(1-2 a^2) ( 24 points) cvw code=5: (a,b,0) etc, b=sqrt(1-a^2), a input ( 24 points) cvw code=6: (a,b,c) etc, c=sqrt(1-a^2-b^2), a/b input ( 48 points) cvw goto (1,2,3,4,5,6) code write (6,*) 'Gen_Oh: Invalid Code' stop 1 continue a=1.0d0 x(1) = a y(1) = 0.0d0 z(1) = 0.0d0 w(1) = v x(2) = -a y(2) = 0.0d0 z(2) = 0.0d0 w(2) = v x(3) = 0.0d0 y(3) = a z(3) = 0.0d0 w(3) = v x(4) = 0.0d0 y(4) = -a z(4) = 0.0d0 w(4) = v x(5) = 0.0d0 y(5) = 0.0d0 z(5) = a w(5) = v x(6) = 0.0d0 y(6) = 0.0d0 z(6) = -a w(6) = v num=num+6 return cvw 2 continue a=sqrt(0.5d0) x( 1) = 0d0 y( 1) = a z( 1) = a w( 1) = v x( 2) = 0d0 y( 2) = -a z( 2) = a w( 2) = v x( 3) = 0d0 y( 3) = a z( 3) = -a w( 3) = v x( 4) = 0d0 y( 4) = -a z( 4) = -a w( 4) = v x( 5) = a y( 5) = 0d0 z( 5) = a w( 5) = v x( 6) = -a y( 6) = 0d0 z( 6) = a w( 6) = v x( 7) = a y( 7) = 0d0 z( 7) = -a w( 7) = v x( 8) = -a y( 8) = 0d0 z( 8) = -a w( 8) = v x( 9) = a y( 9) = a z( 9) = 0d0 w( 9) = v x(10) = -a y(10) = a z(10) = 0d0 w(10) = v x(11) = a y(11) = -a z(11) = 0d0 w(11) = v x(12) = -a y(12) = -a z(12) = 0d0 w(12) = v num=num+12 return cvw 3 continue a = sqrt(1d0/3d0) x(1) = a y(1) = a z(1) = a w(1) = v x(2) = -a y(2) = a z(2) = a w(2) = v x(3) = a y(3) = -a z(3) = a w(3) = v x(4) = -a y(4) = -a z(4) = a w(4) = v x(5) = a y(5) = a z(5) = -a w(5) = v x(6) = -a y(6) = a z(6) = -a w(6) = v x(7) = a y(7) = -a z(7) = -a w(7) = v x(8) = -a y(8) = -a z(8) = -a w(8) = v num=num+8 return cvw 4 continue b = sqrt(1d0 - 2d0*a*a) x( 1) = a y( 1) = a z( 1) = b w( 1) = v x( 2) = -a y( 2) = a z( 2) = b w( 2) = v x( 3) = a y( 3) = -a z( 3) = b w( 3) = v x( 4) = -a y( 4) = -a z( 4) = b w( 4) = v x( 5) = a y( 5) = a z( 5) = -b w( 5) = v x( 6) = -a y( 6) = a z( 6) = -b w( 6) = v x( 7) = a y( 7) = -a z( 7) = -b w( 7) = v x( 8) = -a y( 8) = -a z( 8) = -b w( 8) = v x( 9) = a y( 9) = b z( 9) = a w( 9) = v x(10) = -a y(10) = b z(10) = a w(10) = v x(11) = a y(11) = -b z(11) = a w(11) = v x(12) = -a y(12) = -b z(12) = a w(12) = v x(13) = a y(13) = b z(13) = -a w(13) = v x(14) = -a y(14) = b z(14) = -a w(14) = v x(15) = a y(15) = -b z(15) = -a w(15) = v x(16) = -a y(16) = -b z(16) = -a w(16) = v x(17) = b y(17) = a z(17) = a w(17) = v x(18) = -b y(18) = a z(18) = a w(18) = v x(19) = b y(19) = -a z(19) = a w(19) = v x(20) = -b y(20) = -a z(20) = a w(20) = v x(21) = b y(21) = a z(21) = -a w(21) = v x(22) = -b y(22) = a z(22) = -a w(22) = v x(23) = b y(23) = -a z(23) = -a w(23) = v x(24) = -b y(24) = -a z(24) = -a w(24) = v num=num+24 return cvw 5 continue b=sqrt(1d0-a*a) x( 1) = a y( 1) = b z( 1) = 0d0 w( 1) = v x( 2) = -a y( 2) = b z( 2) = 0d0 w( 2) = v x( 3) = a y( 3) = -b z( 3) = 0d0 w( 3) = v x( 4) = -a y( 4) = -b z( 4) = 0d0 w( 4) = v x( 5) = b y( 5) = a z( 5) = 0d0 w( 5) = v x( 6) = -b y( 6) = a z( 6) = 0d0 w( 6) = v x( 7) = b y( 7) = -a z( 7) = 0d0 w( 7) = v x( 8) = -b y( 8) = -a z( 8) = 0d0 w( 8) = v x( 9) = a y( 9) = 0d0 z( 9) = b w( 9) = v x(10) = -a y(10) = 0d0 z(10) = b w(10) = v x(11) = a y(11) = 0d0 z(11) = -b w(11) = v x(12) = -a y(12) = 0d0 z(12) = -b w(12) = v x(13) = b y(13) = 0d0 z(13) = a w(13) = v x(14) = -b y(14) = 0d0 z(14) = a w(14) = v x(15) = b y(15) = 0d0 z(15) = -a w(15) = v x(16) = -b y(16) = 0d0 z(16) = -a w(16) = v x(17) = 0d0 y(17) = a z(17) = b w(17) = v x(18) = 0d0 y(18) = -a z(18) = b w(18) = v x(19) = 0d0 y(19) = a z(19) = -b w(19) = v x(20) = 0d0 y(20) = -a z(20) = -b w(20) = v x(21) = 0d0 y(21) = b z(21) = a w(21) = v x(22) = 0d0 y(22) = -b z(22) = a w(22) = v x(23) = 0d0 y(23) = b z(23) = -a w(23) = v x(24) = 0d0 y(24) = -b z(24) = -a w(24) = v num=num+24 return cvw 6 continue c=sqrt(1d0 - a*a - b*b) x( 1) = a y( 1) = b z( 1) = c w( 1) = v x( 2) = -a y( 2) = b z( 2) = c w( 2) = v x( 3) = a y( 3) = -b z( 3) = c w( 3) = v x( 4) = -a y( 4) = -b z( 4) = c w( 4) = v x( 5) = a y( 5) = b z( 5) = -c w( 5) = v x( 6) = -a y( 6) = b z( 6) = -c w( 6) = v x( 7) = a y( 7) = -b z( 7) = -c w( 7) = v x( 8) = -a y( 8) = -b z( 8) = -c w( 8) = v x( 9) = a y( 9) = c z( 9) = b w( 9) = v x(10) = -a y(10) = c z(10) = b w(10) = v x(11) = a y(11) = -c z(11) = b w(11) = v x(12) = -a y(12) = -c z(12) = b w(12) = v x(13) = a y(13) = c z(13) = -b w(13) = v x(14) = -a y(14) = c z(14) = -b w(14) = v x(15) = a y(15) = -c z(15) = -b w(15) = v x(16) = -a y(16) = -c z(16) = -b w(16) = v x(17) = b y(17) = a z(17) = c w(17) = v x(18) = -b y(18) = a z(18) = c w(18) = v x(19) = b y(19) = -a z(19) = c w(19) = v x(20) = -b y(20) = -a z(20) = c w(20) = v x(21) = b y(21) = a z(21) = -c w(21) = v x(22) = -b y(22) = a z(22) = -c w(22) = v x(23) = b y(23) = -a z(23) = -c w(23) = v x(24) = -b y(24) = -a z(24) = -c w(24) = v x(25) = b y(25) = c z(25) = a w(25) = v x(26) = -b y(26) = c z(26) = a w(26) = v x(27) = b y(27) = -c z(27) = a w(27) = v x(28) = -b y(28) = -c z(28) = a w(28) = v x(29) = b y(29) = c z(29) = -a w(29) = v x(30) = -b y(30) = c z(30) = -a w(30) = v x(31) = b y(31) = -c z(31) = -a w(31) = v x(32) = -b y(32) = -c z(32) = -a w(32) = v x(33) = c y(33) = a z(33) = b w(33) = v x(34) = -c y(34) = a z(34) = b w(34) = v x(35) = c y(35) = -a z(35) = b w(35) = v x(36) = -c y(36) = -a z(36) = b w(36) = v x(37) = c y(37) = a z(37) = -b w(37) = v x(38) = -c y(38) = a z(38) = -b w(38) = v x(39) = c y(39) = -a z(39) = -b w(39) = v x(40) = -c y(40) = -a z(40) = -b w(40) = v x(41) = c y(41) = b z(41) = a w(41) = v x(42) = -c y(42) = b z(42) = a w(42) = v x(43) = c y(43) = -b z(43) = a w(43) = v x(44) = -c y(44) = -b z(44) = a w(44) = v x(45) = c y(45) = b z(45) = -a w(45) = v x(46) = -c y(46) = b z(46) = -a w(46) = v x(47) = c y(47) = -b z(47) = -a w(47) = v x(48) = -c y(48) = -b z(48) = -a w(48) = v num=num+48 return end SUBROUTINE LD0006(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 6-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.1666666666666667D+0 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0014(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 14-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.6666666666666667D-1 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.7500000000000000D-1 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0026(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 26-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.4761904761904762D-1 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.3809523809523810D-1 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.3214285714285714D-1 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0038(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 38-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.9523809523809524D-2 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.3214285714285714D-1 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4597008433809831D+0 V=0.2857142857142857D-1 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0050(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 50-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.1269841269841270D-1 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.2257495590828924D-1 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.2109375000000000D-1 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3015113445777636D+0 V=0.2017333553791887D-1 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0074(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 74-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.5130671797338464D-3 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.1660406956574204D-1 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=-0.2958603896103896D-1 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4803844614152614D+0 V=0.2657620708215946D-1 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3207726489807764D+0 V=0.1652217099371571D-1 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0086(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 86-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.1154401154401154D-1 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.1194390908585628D-1 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3696028464541502D+0 V=0.1111055571060340D-1 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6943540066026664D+0 V=0.1187650129453714D-1 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3742430390903412D+0 V=0.1181230374690448D-1 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0110(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 110-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.3828270494937162D-2 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.9793737512487512D-2 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1851156353447362D+0 V=0.8211737283191111D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6904210483822922D+0 V=0.9942814891178103D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3956894730559419D+0 V=0.9595471336070963D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4783690288121502D+0 V=0.9694996361663028D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0146(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 146-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.5996313688621381D-3 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.7372999718620756D-2 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.7210515360144488D-2 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6764410400114264D+0 V=0.7116355493117555D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4174961227965453D+0 V=0.6753829486314477D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1574676672039082D+0 V=0.7574394159054034D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1403553811713183D+0 B=0.4493328323269557D+0 V=0.6991087353303262D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0170(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 170-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.5544842902037365D-2 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.6071332770670752D-2 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.6383674773515093D-2 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2551252621114134D+0 V=0.5183387587747790D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6743601460362766D+0 V=0.6317929009813725D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4318910696719410D+0 V=0.6201670006589077D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2613931360335988D+0 V=0.5477143385137348D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4990453161796037D+0 B=0.1446630744325115D+0 V=0.5968383987681156D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0194(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 194-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.1782340447244611D-2 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.5716905949977102D-2 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.5573383178848738D-2 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6712973442695226D+0 V=0.5608704082587997D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2892465627575439D+0 V=0.5158237711805383D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4446933178717437D+0 V=0.5518771467273614D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1299335447650067D+0 V=0.4106777028169394D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3457702197611283D+0 V=0.5051846064614808D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1590417105383530D+0 B=0.8360360154824589D+0 V=0.5530248916233094D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0230(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 230-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=-0.5522639919727325D-1 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.4450274607445226D-2 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4492044687397611D+0 V=0.4496841067921404D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2520419490210201D+0 V=0.5049153450478750D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6981906658447242D+0 V=0.3976408018051883D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6587405243460960D+0 V=0.4401400650381014D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4038544050097660D-1 V=0.1724544350544401D-1 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5823842309715585D+0 V=0.4231083095357343D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3545877390518688D+0 V=0.5198069864064399D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2272181808998187D+0 B=0.4864661535886647D+0 V=0.4695720972568883D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0266(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 266-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=-0.1313769127326952D-2 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=-0.2522728704859336D-2 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.4186853881700583D-2 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7039373391585475D+0 V=0.5315167977810885D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1012526248572414D+0 V=0.4047142377086219D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4647448726420539D+0 V=0.4112482394406990D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3277420654971629D+0 V=0.3595584899758782D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6620338663699974D+0 V=0.4256131351428158D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8506508083520399D+0 V=0.4229582700647240D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3233484542692899D+0 B=0.1153112011009701D+0 V=0.4080914225780505D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2314790158712601D+0 B=0.5244939240922365D+0 V=0.4071467593830964D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0302(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 302-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.8545911725128148D-3 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.3599119285025571D-2 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3515640345570105D+0 V=0.3449788424305883D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6566329410219612D+0 V=0.3604822601419882D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4729054132581005D+0 V=0.3576729661743367D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9618308522614784D-1 V=0.2352101413689164D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2219645236294178D+0 V=0.3108953122413675D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7011766416089545D+0 V=0.3650045807677255D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2644152887060663D+0 V=0.2982344963171804D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5718955891878961D+0 V=0.3600820932216460D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2510034751770465D+0 B=0.8000727494073952D+0 V=0.3571540554273387D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1233548532583327D+0 B=0.4127724083168531D+0 V=0.3392312205006170D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0350(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 350-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.3006796749453936D-2 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.3050627745650771D-2 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7068965463912316D+0 V=0.1621104600288991D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4794682625712025D+0 V=0.3005701484901752D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1927533154878019D+0 V=0.2990992529653774D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6930357961327123D+0 V=0.2982170644107595D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3608302115520091D+0 V=0.2721564237310992D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6498486161496169D+0 V=0.3033513795811141D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1932945013230339D+0 V=0.3007949555218533D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3800494919899303D+0 V=0.2881964603055307D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2899558825499574D+0 B=0.7934537856582316D+0 V=0.2958357626535696D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9684121455103957D-1 B=0.8280801506686862D+0 V=0.3036020026407088D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1833434647041659D+0 B=0.9074658265305127D+0 V=0.2832187403926303D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0434(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 434-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.5265897968224436D-3 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.2548219972002607D-2 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.2512317418927307D-2 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6909346307509111D+0 V=0.2530403801186355D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1774836054609158D+0 V=0.2014279020918528D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4914342637784746D+0 V=0.2501725168402936D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6456664707424256D+0 V=0.2513267174597564D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2861289010307638D+0 V=0.2302694782227416D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7568084367178018D-1 V=0.1462495621594614D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3927259763368002D+0 V=0.2445373437312980D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8818132877794288D+0 V=0.2417442375638981D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9776428111182649D+0 V=0.1910951282179532D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2054823696403044D+0 B=0.8689460322872412D+0 V=0.2416930044324775D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5905157048925271D+0 B=0.7999278543857286D+0 V=0.2512236854563495D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5550152361076807D+0 B=0.7717462626915901D+0 V=0.2496644054553086D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9371809858553722D+0 B=0.3344363145343455D+0 V=0.2236607760437849D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0590(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 590-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.3095121295306187D-3 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.1852379698597489D-2 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7040954938227469D+0 V=0.1871790639277744D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6807744066455243D+0 V=0.1858812585438317D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6372546939258752D+0 V=0.1852028828296213D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5044419707800358D+0 V=0.1846715956151242D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4215761784010967D+0 V=0.1818471778162769D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3317920736472123D+0 V=0.1749564657281154D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2384736701421887D+0 V=0.1617210647254411D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1459036449157763D+0 V=0.1384737234851692D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6095034115507196D-1 V=0.9764331165051050D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6116843442009876D+0 V=0.1857161196774078D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3964755348199858D+0 V=0.1705153996395864D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1724782009907724D+0 V=0.1300321685886048D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5610263808622060D+0 B=0.3518280927733519D+0 V=0.1842866472905286D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4742392842551980D+0 B=0.2634716655937950D+0 V=0.1802658934377451D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5984126497885380D+0 B=0.1816640840360209D+0 V=0.1849830560443660D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3791035407695563D+0 B=0.1720795225656878D+0 V=0.1713904507106709D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2778673190586244D+0 B=0.8213021581932511D-1 V=0.1555213603396808D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5033564271075117D+0 B=0.8999205842074875D-1 V=0.1802239128008525D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0770(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 770-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.2192942088181184D-3 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.1436433617319080D-2 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.1421940344335877D-2 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5087204410502360D-1 V=0.6798123511050502D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1228198790178831D+0 V=0.9913184235294912D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2026890814408786D+0 V=0.1180207833238949D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2847745156464294D+0 V=0.1296599602080921D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3656719078978026D+0 V=0.1365871427428316D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4428264886713469D+0 V=0.1402988604775325D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5140619627249735D+0 V=0.1418645563595609D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6306401219166803D+0 V=0.1421376741851662D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6716883332022612D+0 V=0.1423996475490962D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6979792685336881D+0 V=0.1431554042178567D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1446865674195309D+0 V=0.9254401499865368D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3390263475411216D+0 V=0.1250239995053509D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5335804651263506D+0 V=0.1394365843329230D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6944024393349413D-1 B=0.2355187894242326D+0 V=0.1127089094671749D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2269004109529460D+0 B=0.4102182474045730D+0 V=0.1345753760910670D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8025574607775339D-1 B=0.6214302417481605D+0 V=0.1424957283316783D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1467999527896572D+0 B=0.3245284345717394D+0 V=0.1261523341237750D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1571507769824727D+0 B=0.5224482189696630D+0 V=0.1392547106052696D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2365702993157246D+0 B=0.6017546634089558D+0 V=0.1418761677877656D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7714815866765732D-1 B=0.4346575516141163D+0 V=0.1338366684479554D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3062936666210730D+0 B=0.4908826589037616D+0 V=0.1393700862676131D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3822477379524787D+0 B=0.5648768149099500D+0 V=0.1415914757466932D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD0974(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 974-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.1438294190527431D-3 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.1125772288287004D-2 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4292963545341347D-1 V=0.4948029341949241D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1051426854086404D+0 V=0.7357990109125470D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1750024867623087D+0 V=0.8889132771304384D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2477653379650257D+0 V=0.9888347838921435D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3206567123955957D+0 V=0.1053299681709471D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3916520749849983D+0 V=0.1092778807014578D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4590825874187624D+0 V=0.1114389394063227D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5214563888415861D+0 V=0.1123724788051555D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6253170244654199D+0 V=0.1125239325243814D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6637926744523170D+0 V=0.1126153271815905D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6910410398498301D+0 V=0.1130286931123841D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7052907007457760D+0 V=0.1134986534363955D-2 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1236686762657990D+0 V=0.6823367927109931D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2940777114468387D+0 V=0.9454158160447096D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4697753849207649D+0 V=0.1074429975385679D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6334563241139567D+0 V=0.1129300086569132D-2 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5974048614181342D-1 B=0.2029128752777523D+0 V=0.8436884500901954D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1375760408473636D+0 B=0.4602621942484054D+0 V=0.1075255720448885D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3391016526336286D+0 B=0.5030673999662036D+0 V=0.1108577236864462D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1271675191439820D+0 B=0.2817606422442134D+0 V=0.9566475323783357D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2693120740413512D+0 B=0.4331561291720157D+0 V=0.1080663250717391D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1419786452601918D+0 B=0.6256167358580814D+0 V=0.1126797131196295D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6709284600738255D-1 B=0.3798395216859157D+0 V=0.1022568715358061D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7057738183256172D-1 B=0.5517505421423520D+0 V=0.1108960267713108D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2783888477882155D+0 B=0.6029619156159187D+0 V=0.1122790653435766D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1979578938917407D+0 B=0.3589606329589096D+0 V=0.1032401847117460D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2087307061103274D+0 B=0.5348666438135476D+0 V=0.1107249382283854D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4055122137872836D+0 B=0.5674997546074373D+0 V=0.1121780048519972D-2 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD1202(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 1202-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.1105189233267572D-3 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.9205232738090741D-3 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.9133159786443561D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3712636449657089D-1 V=0.3690421898017899D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9140060412262223D-1 V=0.5603990928680660D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1531077852469906D+0 V=0.6865297629282609D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2180928891660612D+0 V=0.7720338551145630D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2839874532200175D+0 V=0.8301545958894795D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3491177600963764D+0 V=0.8686692550179628D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4121431461444309D+0 V=0.8927076285846890D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4718993627149127D+0 V=0.9060820238568219D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5273145452842337D+0 V=0.9119777254940867D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6209475332444019D+0 V=0.9128720138604181D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6569722711857291D+0 V=0.9130714935691735D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6841788309070143D+0 V=0.9152873784554116D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7012604330123631D+0 V=0.9187436274321654D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1072382215478166D+0 V=0.5176977312965694D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2582068959496968D+0 V=0.7331143682101417D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4172752955306717D+0 V=0.8463232836379928D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5700366911792503D+0 V=0.9031122694253992D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9827986018263947D+0 B=0.1771774022615325D+0 V=0.6485778453163257D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9624249230326228D+0 B=0.2475716463426288D+0 V=0.7435030910982369D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9402007994128811D+0 B=0.3354616289066489D+0 V=0.7998527891839054D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9320822040143202D+0 B=0.3173615246611977D+0 V=0.8101731497468018D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9043674199393299D+0 B=0.4090268427085357D+0 V=0.8483389574594331D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8912407560074747D+0 B=0.3854291150669224D+0 V=0.8556299257311812D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8676435628462708D+0 B=0.4932221184851285D+0 V=0.8803208679738260D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8581979986041619D+0 B=0.4785320675922435D+0 V=0.8811048182425720D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8396753624049856D+0 B=0.4507422593157064D+0 V=0.8850282341265444D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8165288564022188D+0 B=0.5632123020762100D+0 V=0.9021342299040653D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8015469370783529D+0 B=0.5434303569693900D+0 V=0.9010091677105086D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7773563069070351D+0 B=0.5123518486419871D+0 V=0.9022692938426915D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7661621213900394D+0 B=0.6394279634749102D+0 V=0.9158016174693465D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7553584143533510D+0 B=0.6269805509024392D+0 V=0.9131578003189435D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7344305757559503D+0 B=0.6031161693096310D+0 V=0.9107813579482705D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7043837184021765D+0 B=0.5693702498468441D+0 V=0.9105760258970126D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD1454(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 1454-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.7777160743261247D-4 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.7557646413004701D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3229290663413854D-1 V=0.2841633806090617D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8036733271462222D-1 V=0.4374419127053555D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1354289960531653D+0 V=0.5417174740872172D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1938963861114426D+0 V=0.6148000891358593D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2537343715011275D+0 V=0.6664394485800705D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3135251434752570D+0 V=0.7025039356923220D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3721558339375338D+0 V=0.7268511789249627D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4286809575195696D+0 V=0.7422637534208629D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4822510128282994D+0 V=0.7509545035841214D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5320679333566263D+0 V=0.7548535057718401D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6172998195394274D+0 V=0.7554088969774001D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6510679849127481D+0 V=0.7553147174442808D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6777315251687360D+0 V=0.7564767653292297D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6963109410648741D+0 V=0.7587991808518730D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7058935009831749D+0 V=0.7608261832033027D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9955546194091857D+0 V=0.4021680447874916D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9734115901794209D+0 V=0.5804871793945964D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9275693732388626D+0 V=0.6792151955945159D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8568022422795103D+0 V=0.7336741211286294D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7623495553719372D+0 V=0.7581866300989608D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5707522908892223D+0 B=0.4387028039889501D+0 V=0.7538257859800743D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5196463388403083D+0 B=0.3858908414762617D+0 V=0.7483517247053123D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4646337531215351D+0 B=0.3301937372343854D+0 V=0.7371763661112059D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4063901697557691D+0 B=0.2725423573563777D+0 V=0.7183448895756934D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3456329466643087D+0 B=0.2139510237495250D+0 V=0.6895815529822191D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2831395121050332D+0 B=0.1555922309786647D+0 V=0.6480105801792886D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2197682022925330D+0 B=0.9892878979686097D-1 V=0.5897558896594636D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1564696098650355D+0 B=0.4598642910675510D-1 V=0.5095708849247346D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6027356673721295D+0 B=0.3376625140173426D+0 V=0.7536906428909755D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5496032320255096D+0 B=0.2822301309727988D+0 V=0.7472505965575118D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4921707755234567D+0 B=0.2248632342592540D+0 V=0.7343017132279698D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4309422998598483D+0 B=0.1666224723456479D+0 V=0.7130871582177445D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3664108182313672D+0 B=0.1086964901822169D+0 V=0.6817022032112776D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2990189057758436D+0 B=0.5251989784120085D-1 V=0.6380941145604121D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6268724013144998D+0 B=0.2297523657550023D+0 V=0.7550381377920310D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5707324144834607D+0 B=0.1723080607093800D+0 V=0.7478646640144802D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5096360901960365D+0 B=0.1140238465390513D+0 V=0.7335918720601220D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4438729938312456D+0 B=0.5611522095882537D-1 V=0.7110120527658118D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6419978471082389D+0 B=0.1164174423140873D+0 V=0.7571363978689501D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5817218061802611D+0 B=0.5797589531445219D-1 V=0.7489908329079234D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD1730(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 1730-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.6309049437420976D-4 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.6398287705571748D-3 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.6357185073530720D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2860923126194662D-1 V=0.2221207162188168D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7142556767711522D-1 V=0.3475784022286848D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1209199540995559D+0 V=0.4350742443589804D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1738673106594379D+0 V=0.4978569136522127D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2284645438467734D+0 V=0.5435036221998053D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2834807671701512D+0 V=0.5765913388219542D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3379680145467339D+0 V=0.6001200359226003D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3911355454819537D+0 V=0.6162178172717512D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4422860353001403D+0 V=0.6265218152438485D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4907781568726057D+0 V=0.6323987160974212D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5360006153211468D+0 V=0.6350767851540569D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6142105973596603D+0 V=0.6354362775297107D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6459300387977504D+0 V=0.6352302462706235D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6718056125089225D+0 V=0.6358117881417972D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6910888533186254D+0 V=0.6373101590310117D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7030467416823252D+0 V=0.6390428961368665D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8354951166354646D-1 V=0.3186913449946576D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2050143009099486D+0 V=0.4678028558591711D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3370208290706637D+0 V=0.5538829697598626D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4689051484233963D+0 V=0.6044475907190476D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5939400424557334D+0 V=0.6313575103509012D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1394983311832261D+0 B=0.4097581162050343D-1 V=0.4078626431855630D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1967999180485014D+0 B=0.8851987391293348D-1 V=0.4759933057812725D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2546183732548967D+0 B=0.1397680182969819D+0 V=0.5268151186413440D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3121281074713875D+0 B=0.1929452542226526D+0 V=0.5643048560507316D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3685981078502492D+0 B=0.2467898337061562D+0 V=0.5914501076613073D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4233760321547856D+0 B=0.3003104124785409D+0 V=0.6104561257874195D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4758671236059246D+0 B=0.3526684328175033D+0 V=0.6230252860707806D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5255178579796463D+0 B=0.4031134861145713D+0 V=0.6305618761760796D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5718025633734589D+0 B=0.4509426448342351D+0 V=0.6343092767597889D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2686927772723415D+0 B=0.4711322502423248D-1 V=0.5176268945737826D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3306006819904809D+0 B=0.9784487303942695D-1 V=0.5564840313313692D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3904906850594983D+0 B=0.1505395810025273D+0 V=0.5856426671038980D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4479957951904390D+0 B=0.2039728156296050D+0 V=0.6066386925777091D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5027076848919780D+0 B=0.2571529941121107D+0 V=0.6208824962234458D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5542087392260217D+0 B=0.3092191375815670D+0 V=0.6296314297822907D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6020850887375187D+0 B=0.3593807506130276D+0 V=0.6340423756791859D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4019851409179594D+0 B=0.5063389934378671D-1 V=0.5829627677107342D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4635614567449800D+0 B=0.1032422269160612D+0 V=0.6048693376081110D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5215860931591575D+0 B=0.1566322094006254D+0 V=0.6202362317732461D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5758202499099271D+0 B=0.2098082827491099D+0 V=0.6299005328403779D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6259893683876795D+0 B=0.2618824114553391D+0 V=0.6347722390609353D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5313795124811891D+0 B=0.5263245019338556D-1 V=0.6203778981238834D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5893317955931995D+0 B=0.1061059730982005D+0 V=0.6308414671239979D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6426246321215801D+0 B=0.1594171564034221D+0 V=0.6362706466959498D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6511904367376113D+0 B=0.5354789536565540D-1 V=0.6375414170333233D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD2030(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 2030-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.4656031899197431D-4 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.5421549195295507D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2540835336814348D-1 V=0.1778522133346553D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6399322800504915D-1 V=0.2811325405682796D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1088269469804125D+0 V=0.3548896312631459D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1570670798818287D+0 V=0.4090310897173364D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2071163932282514D+0 V=0.4493286134169965D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2578914044450844D+0 V=0.4793728447962723D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3085687558169623D+0 V=0.5015415319164265D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3584719706267024D+0 V=0.5175127372677937D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4070135594428709D+0 V=0.5285522262081019D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4536618626222638D+0 V=0.5356832703713962D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4979195686463577D+0 V=0.5397914736175170D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5393075111126999D+0 V=0.5416899441599930D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6115617676843916D+0 V=0.5419308476889938D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6414308435160159D+0 V=0.5416936902030596D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6664099412721607D+0 V=0.5419544338703164D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6859161771214913D+0 V=0.5428983656630975D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6993625593503890D+0 V=0.5442286500098193D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7062393387719380D+0 V=0.5452250345057301D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7479028168349763D-1 V=0.2568002497728530D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1848951153969366D+0 V=0.3827211700292145D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3059529066581305D+0 V=0.4579491561917824D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4285556101021362D+0 V=0.5042003969083574D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5468758653496526D+0 V=0.5312708889976025D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6565821978343439D+0 V=0.5438401790747117D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1253901572367117D+0 B=0.3681917226439641D-1 V=0.3316041873197344D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1775721510383941D+0 B=0.7982487607213301D-1 V=0.3899113567153771D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2305693358216114D+0 B=0.1264640966592335D+0 V=0.4343343327201309D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2836502845992063D+0 B=0.1751585683418957D+0 V=0.4679415262318919D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3361794746232590D+0 B=0.2247995907632670D+0 V=0.4930847981631031D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3875979172264824D+0 B=0.2745299257422246D+0 V=0.5115031867540091D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4374019316999074D+0 B=0.3236373482441118D+0 V=0.5245217148457367D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4851275843340022D+0 B=0.3714967859436741D+0 V=0.5332041499895321D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5303391803806868D+0 B=0.4175353646321745D+0 V=0.5384583126021542D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5726197380596287D+0 B=0.4612084406355461D+0 V=0.5411067210798852D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2431520732564863D+0 B=0.4258040133043952D-1 V=0.4259797391468714D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3002096800895869D+0 B=0.8869424306722721D-1 V=0.4604931368460021D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3558554457457432D+0 B=0.1368811706510655D+0 V=0.4871814878255202D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4097782537048887D+0 B=0.1860739985015033D+0 V=0.5072242910074885D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4616337666067458D+0 B=0.2354235077395853D+0 V=0.5217069845235350D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5110707008417874D+0 B=0.2842074921347011D+0 V=0.5315785966280310D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5577415286163795D+0 B=0.3317784414984102D+0 V=0.5376833708758905D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6013060431366950D+0 B=0.3775299002040700D+0 V=0.5408032092069521D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3661596767261781D+0 B=0.4599367887164592D-1 V=0.4842744917904866D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4237633153506581D+0 B=0.9404893773654421D-1 V=0.5048926076188130D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4786328454658452D+0 B=0.1431377109091971D+0 V=0.5202607980478373D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5305702076789774D+0 B=0.1924186388843570D+0 V=0.5309932388325743D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5793436224231788D+0 B=0.2411590944775190D+0 V=0.5377419770895208D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6247069017094747D+0 B=0.2886871491583605D+0 V=0.5411696331677717D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4874315552535204D+0 B=0.4804978774953206D-1 V=0.5197996293282420D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5427337322059053D+0 B=0.9716857199366665D-1 V=0.5311120836622945D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5943493747246700D+0 B=0.1465205839795055D+0 V=0.5384309319956951D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6421314033564943D+0 B=0.1953579449803574D+0 V=0.5421859504051886D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6020628374713980D+0 B=0.4916375015738108D-1 V=0.5390948355046314D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6529222529856881D+0 B=0.9861621540127005D-1 V=0.5433312705027845D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD2354(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 2354-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.3922616270665292D-4 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.4703831750854424D-3 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.4678202801282136D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2290024646530589D-1 V=0.1437832228979900D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5779086652271284D-1 V=0.2303572493577644D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9863103576375984D-1 V=0.2933110752447454D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1428155792982185D+0 V=0.3402905998359838D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1888978116601463D+0 V=0.3759138466870372D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2359091682970210D+0 V=0.4030638447899798D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2831228833706171D+0 V=0.4236591432242211D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3299495857966693D+0 V=0.4390522656946746D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3758840802660796D+0 V=0.4502523466626247D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4204751831009480D+0 V=0.4580577727783541D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4633068518751051D+0 V=0.4631391616615899D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5039849474507313D+0 V=0.4660928953698676D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5421265793440747D+0 V=0.4674751807936953D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6092660230557310D+0 V=0.4676414903932920D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6374654204984869D+0 V=0.4674086492347870D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6615136472609892D+0 V=0.4674928539483207D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6809487285958127D+0 V=0.4680748979686447D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6952980021665196D+0 V=0.4690449806389040D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7041245497695400D+0 V=0.4699877075860818D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6744033088306065D-1 V=0.2099942281069176D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1678684485334166D+0 V=0.3172269150712804D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2793559049539613D+0 V=0.3832051358546523D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3935264218057639D+0 V=0.4252193818146985D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5052629268232558D+0 V=0.4513807963755000D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6107905315437531D+0 V=0.4657797469114178D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1135081039843524D+0 B=0.3331954884662588D-1 V=0.2733362800522836D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1612866626099378D+0 B=0.7247167465436538D-1 V=0.3235485368463559D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2100786550168205D+0 B=0.1151539110849745D+0 V=0.3624908726013453D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2592282009459942D+0 B=0.1599491097143677D+0 V=0.3925540070712828D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3081740561320203D+0 B=0.2058699956028027D+0 V=0.4156129781116235D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3564289781578164D+0 B=0.2521624953502911D+0 V=0.4330644984623263D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4035587288240703D+0 B=0.2982090785797674D+0 V=0.4459677725921312D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4491671196373903D+0 B=0.3434762087235733D+0 V=0.4551593004456795D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4928854782917489D+0 B=0.3874831357203437D+0 V=0.4613341462749918D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5343646791958988D+0 B=0.4297814821746926D+0 V=0.4651019618269806D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5732683216530990D+0 B=0.4699402260943537D+0 V=0.4670249536100625D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2214131583218986D+0 B=0.3873602040643895D-1 V=0.3549555576441708D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2741796504750071D+0 B=0.8089496256902013D-1 V=0.3856108245249010D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3259797439149485D+0 B=0.1251732177620872D+0 V=0.4098622845756882D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3765441148826891D+0 B=0.1706260286403185D+0 V=0.4286328604268950D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4255773574530558D+0 B=0.2165115147300408D+0 V=0.4427802198993945D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4727795117058430D+0 B=0.2622089812225259D+0 V=0.4530473511488561D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5178546895819012D+0 B=0.3071721431296201D+0 V=0.4600805475703138D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5605141192097460D+0 B=0.3508998998801138D+0 V=0.4644599059958017D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6004763319352512D+0 B=0.3929160876166931D+0 V=0.4667274455712508D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3352842634946949D+0 B=0.4202563457288019D-1 V=0.4069360518020356D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3891971629814670D+0 B=0.8614309758870850D-1 V=0.4260442819919195D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4409875565542281D+0 B=0.1314500879380001D+0 V=0.4408678508029063D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4904893058592484D+0 B=0.1772189657383859D+0 V=0.4518748115548597D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5375056138769549D+0 B=0.2228277110050294D+0 V=0.4595564875375116D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5818255708669969D+0 B=0.2677179935014386D+0 V=0.4643988774315846D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6232334858144959D+0 B=0.3113675035544165D+0 V=0.4668827491646946D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4489485354492058D+0 B=0.4409162378368174D-1 V=0.4400541823741973D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5015136875933150D+0 B=0.8939009917748489D-1 V=0.4514512890193797D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5511300550512623D+0 B=0.1351806029383365D+0 V=0.4596198627347549D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5976720409858000D+0 B=0.1808370355053196D+0 V=0.4648659016801781D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6409956378989354D+0 B=0.2257852192301602D+0 V=0.4675502017157673D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5581222330827514D+0 B=0.4532173421637160D-1 V=0.4598494476455523D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6074705984161695D+0 B=0.9117488031840314D-1 V=0.4654916955152048D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6532272537379033D+0 B=0.1369294213140155D+0 V=0.4684709779505137D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6594761494500487D+0 B=0.4589901487275583D-1 V=0.4691445539106986D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD2702(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 2702-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.2998675149888161D-4 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.4077860529495355D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2065562538818703D-1 V=0.1185349192520667D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5250918173022379D-1 V=0.1913408643425751D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8993480082038376D-1 V=0.2452886577209897D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1306023924436019D+0 V=0.2862408183288702D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1732060388531418D+0 V=0.3178032258257357D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2168727084820249D+0 V=0.3422945667633690D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2609528309173586D+0 V=0.3612790520235922D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3049252927938952D+0 V=0.3758638229818521D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3483484138084404D+0 V=0.3868711798859953D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3908321549106406D+0 V=0.3949429933189938D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4320210071894814D+0 V=0.4006068107541156D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4715824795890053D+0 V=0.4043192149672723D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5091984794078453D+0 V=0.4064947495808078D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5445580145650803D+0 V=0.4075245619813152D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6072575796841768D+0 V=0.4076423540893566D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6339484505755803D+0 V=0.4074280862251555D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6570718257486958D+0 V=0.4074163756012244D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6762557330090709D+0 V=0.4077647795071246D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6911161696923790D+0 V=0.4084517552782530D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7012841911659961D+0 V=0.4092468459224052D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7064559272410020D+0 V=0.4097872687240906D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6123554989894765D-1 V=0.1738986811745028D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1533070348312393D+0 V=0.2659616045280191D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2563902605244206D+0 V=0.3240596008171533D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3629346991663361D+0 V=0.3621195964432943D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4683949968987538D+0 V=0.3868838330760539D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5694479240657952D+0 V=0.4018911532693111D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6634465430993955D+0 V=0.4089929432983252D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1033958573552305D+0 B=0.3034544009063584D-1 V=0.2279907527706409D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1473521412414395D+0 B=0.6618803044247135D-1 V=0.2715205490578897D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1924552158705967D+0 B=0.1054431128987715D+0 V=0.3057917896703976D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2381094362890328D+0 B=0.1468263551238858D+0 V=0.3326913052452555D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2838121707936760D+0 B=0.1894486108187886D+0 V=0.3537334711890037D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3291323133373415D+0 B=0.2326374238761579D+0 V=0.3700567500783129D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3736896978741460D+0 B=0.2758485808485768D+0 V=0.3825245372589122D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4171406040760013D+0 B=0.3186179331996921D+0 V=0.3918125171518296D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4591677985256915D+0 B=0.3605329796303794D+0 V=0.3984720419937579D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4994733831718418D+0 B=0.4012147253586509D+0 V=0.4029746003338211D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5377731830445096D+0 B=0.4403050025570692D+0 V=0.4057428632156627D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5737917830001331D+0 B=0.4774565904277483D+0 V=0.4071719274114857D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2027323586271389D+0 B=0.3544122504976147D-1 V=0.2990236950664119D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2516942375187273D+0 B=0.7418304388646328D-1 V=0.3262951734212878D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3000227995257181D+0 B=0.1150502745727186D+0 V=0.3482634608242413D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3474806691046342D+0 B=0.1571963371209364D+0 V=0.3656596681700892D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3938103180359209D+0 B=0.1999631877247100D+0 V=0.3791740467794218D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4387519590455703D+0 B=0.2428073457846535D+0 V=0.3894034450156905D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4820503960077787D+0 B=0.2852575132906155D+0 V=0.3968600245508371D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5234573778475101D+0 B=0.3268884208674639D+0 V=0.4019931351420050D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5627318647235282D+0 B=0.3673033321675939D+0 V=0.4052108801278599D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5996390607156954D+0 B=0.4061211551830290D+0 V=0.4068978613940934D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3084780753791947D+0 B=0.3860125523100059D-1 V=0.3454275351319704D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3589988275920223D+0 B=0.7928938987104867D-1 V=0.3629963537007920D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4078628415881973D+0 B=0.1212614643030087D+0 V=0.3770187233889873D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4549287258889735D+0 B=0.1638770827382693D+0 V=0.3878608613694378D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5000278512957279D+0 B=0.2065965798260176D+0 V=0.3959065270221274D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5429785044928199D+0 B=0.2489436378852235D+0 V=0.4015286975463570D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5835939850491711D+0 B=0.2904811368946891D+0 V=0.4050866785614717D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6216870353444856D+0 B=0.3307941957666609D+0 V=0.4069320185051913D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4151104662709091D+0 B=0.4064829146052554D-1 V=0.3760120964062763D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4649804275009218D+0 B=0.8258424547294755D-1 V=0.3870969564418064D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5124695757009662D+0 B=0.1251841962027289D+0 V=0.3955287790534055D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5574711100606224D+0 B=0.1679107505976331D+0 V=0.4015361911302668D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5998597333287227D+0 B=0.2102805057358715D+0 V=0.4053836986719548D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6395007148516600D+0 B=0.2518418087774107D+0 V=0.4073578673299117D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5188456224746252D+0 B=0.4194321676077518D-1 V=0.3954628379231406D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5664190707942778D+0 B=0.8457661551921499D-1 V=0.4017645508847530D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6110464353283153D+0 B=0.1273652932519396D+0 V=0.4059030348651293D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6526430302051563D+0 B=0.1698173239076354D+0 V=0.4080565809484880D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6167551880377548D+0 B=0.4266398851548864D-1 V=0.4063018753664651D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6607195418355383D+0 B=0.8551925814238349D-1 V=0.4087191292799671D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD3074(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 3074-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.2599095953754734D-4 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.3603134089687541D-3 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.3586067974412447D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1886108518723392D-1 V=0.9831528474385880D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4800217244625303D-1 V=0.1605023107954450D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8244922058397242D-1 V=0.2072200131464099D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1200408362484023D+0 V=0.2431297618814187D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1595773530809965D+0 V=0.2711819064496707D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2002635973434064D+0 V=0.2932762038321116D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2415127590139982D+0 V=0.3107032514197368D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2828584158458477D+0 V=0.3243808058921213D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3239091015338138D+0 V=0.3349899091374030D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3643225097962194D+0 V=0.3430580688505218D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4037897083691802D+0 V=0.3490124109290343D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4420247515194127D+0 V=0.3532148948561955D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4787572538464938D+0 V=0.3559862669062833D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5137265251275234D+0 V=0.3576224317551411D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5466764056654611D+0 V=0.3584050533086076D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6054859420813535D+0 V=0.3584903581373224D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6308106701764562D+0 V=0.3582991879040586D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6530369230179584D+0 V=0.3582371187963125D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6718609524611158D+0 V=0.3584353631122350D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6869676499894013D+0 V=0.3589120166517785D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6980467077240748D+0 V=0.3595445704531601D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7048241721250522D+0 V=0.3600943557111074D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5591105222058232D-1 V=0.1456447096742039D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1407384078513916D+0 V=0.2252370188283782D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2364035438976309D+0 V=0.2766135443474897D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3360602737818170D+0 V=0.3110729491500851D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4356292630054665D+0 V=0.3342506712303391D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5321569415256174D+0 V=0.3491981834026860D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6232956305040554D+0 V=0.3576003604348932D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9469870086838469D-1 B=0.2778748387309470D-1 V=0.1921921305788564D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1353170300568141D+0 B=0.6076569878628364D-1 V=0.2301458216495632D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1771679481726077D+0 B=0.9703072762711040D-1 V=0.2604248549522893D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2197066664231751D+0 B=0.1354112458524762D+0 V=0.2845275425870697D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2624783557374927D+0 B=0.1750996479744100D+0 V=0.3036870897974840D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3050969521214442D+0 B=0.2154896907449802D+0 V=0.3188414832298066D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3472252637196021D+0 B=0.2560954625740152D+0 V=0.3307046414722089D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3885610219026360D+0 B=0.2965070050624096D+0 V=0.3398330969031360D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4288273776062765D+0 B=0.3363641488734497D+0 V=0.3466757899705373D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4677662471302948D+0 B=0.3753400029836788D+0 V=0.3516095923230054D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5051333589553359D+0 B=0.4131297522144286D+0 V=0.3549645184048486D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5406942145810492D+0 B=0.4494423776081795D+0 V=0.3570415969441392D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5742204122576457D+0 B=0.4839938958841502D+0 V=0.3581251798496118D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1865407027225188D+0 B=0.3259144851070796D-1 V=0.2543491329913348D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2321186453689432D+0 B=0.6835679505297343D-1 V=0.2786711051330776D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2773159142523882D+0 B=0.1062284864451989D+0 V=0.2985552361083679D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3219200192237254D+0 B=0.1454404409323047D+0 V=0.3145867929154039D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3657032593944029D+0 B=0.1854018282582510D+0 V=0.3273290662067609D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4084376778363622D+0 B=0.2256297412014750D+0 V=0.3372705511943501D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4499004945751427D+0 B=0.2657104425000896D+0 V=0.3448274437851510D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4898758141326335D+0 B=0.3052755487631557D+0 V=0.3503592783048583D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5281547442266309D+0 B=0.3439863920645423D+0 V=0.3541854792663162D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5645346989813992D+0 B=0.3815229456121914D+0 V=0.3565995517909428D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5988181252159848D+0 B=0.4175752420966734D+0 V=0.3578802078302898D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2850425424471603D+0 B=0.3562149509862536D-1 V=0.2958644592860982D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3324619433027876D+0 B=0.7330318886871096D-1 V=0.3119548129116835D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3785848333076282D+0 B=0.1123226296008472D+0 V=0.3250745225005984D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4232891028562115D+0 B=0.1521084193337708D+0 V=0.3355153415935208D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4664287050829722D+0 B=0.1921844459223610D+0 V=0.3435847568549328D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5078458493735726D+0 B=0.2321360989678303D+0 V=0.3495786831622488D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5473779816204180D+0 B=0.2715886486360520D+0 V=0.3537767805534621D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5848617133811376D+0 B=0.3101924707571355D+0 V=0.3564459815421428D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6201348281584888D+0 B=0.3476121052890973D+0 V=0.3578464061225468D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3852191185387871D+0 B=0.3763224880035108D-1 V=0.3239748762836212D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4325025061073423D+0 B=0.7659581935637135D-1 V=0.3345491784174287D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4778486229734490D+0 B=0.1163381306083900D+0 V=0.3429126177301782D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5211663693009000D+0 B=0.1563890598752899D+0 V=0.3492420343097421D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5623469504853703D+0 B=0.1963320810149200D+0 V=0.3537399050235257D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6012718188659246D+0 B=0.2357847407258738D+0 V=0.3566209152659172D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6378179206390117D+0 B=0.2743846121244060D+0 V=0.3581084321919782D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4836936460214534D+0 B=0.3895902610739024D-1 V=0.3426522117591512D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5293792562683797D+0 B=0.7871246819312640D-1 V=0.3491848770121379D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5726281253100033D+0 B=0.1187963808202981D+0 V=0.3539318235231476D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6133658776169068D+0 B=0.1587914708061787D+0 V=0.3570231438458694D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6515085491865307D+0 B=0.1983058575227646D+0 V=0.3586207335051714D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5778692716064976D+0 B=0.3977209689791542D-1 V=0.3541196205164025D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6207904288086192D+0 B=0.7990157592981152D-1 V=0.3574296911573953D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6608688171046802D+0 B=0.1199671308754309D+0 V=0.3591993279818963D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6656263089489130D+0 B=0.4015955957805969D-1 V=0.3595855034661997D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD3470(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 3470-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.2040382730826330D-4 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.3178149703889544D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1721420832906233D-1 V=0.8288115128076110D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4408875374981770D-1 V=0.1360883192522954D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7594680813878681D-1 V=0.1766854454542662D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1108335359204799D+0 V=0.2083153161230153D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1476517054388567D+0 V=0.2333279544657158D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1856731870860615D+0 V=0.2532809539930247D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2243634099428821D+0 V=0.2692472184211158D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2633006881662727D+0 V=0.2819949946811885D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3021340904916283D+0 V=0.2920953593973030D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3405594048030089D+0 V=0.2999889782948352D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3783044434007372D+0 V=0.3060292120496902D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4151194767407910D+0 V=0.3105109167522192D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4507705766443257D+0 V=0.3136902387550312D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4850346056573187D+0 V=0.3157984652454632D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5176950817792470D+0 V=0.3170516518425422D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5485384240820989D+0 V=0.3176568425633755D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6039117238943308D+0 V=0.3177198411207062D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6279956655573113D+0 V=0.3175519492394733D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6493636169568952D+0 V=0.3174654952634756D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6677644117704504D+0 V=0.3175676415467654D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6829368572115624D+0 V=0.3178923417835410D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6946195818184121D+0 V=0.3183788287531909D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7025711542057026D+0 V=0.3188755151918807D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7066004767140119D+0 V=0.3191916889313849D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5132537689946062D-1 V=0.1231779611744508D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1297994661331225D+0 V=0.1924661373839880D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2188852049401307D+0 V=0.2380881867403424D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3123174824903457D+0 V=0.2693100663037885D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4064037620738195D+0 V=0.2908673382834366D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4984958396944782D+0 V=0.3053914619381535D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5864975046021365D+0 V=0.3143916684147777D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6686711634580175D+0 V=0.3187042244055363D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8715738780835950D-1 B=0.2557175233367578D-1 V=0.1635219535869790D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1248383123134007D+0 B=0.5604823383376681D-1 V=0.1968109917696070D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1638062693383378D+0 B=0.8968568601900765D-1 V=0.2236754342249974D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2035586203373176D+0 B=0.1254086651976279D+0 V=0.2453186687017181D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2436798975293774D+0 B=0.1624780150162012D+0 V=0.2627551791580541D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2838207507773806D+0 B=0.2003422342683208D+0 V=0.2767654860152220D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3236787502217692D+0 B=0.2385628026255263D+0 V=0.2879467027765895D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3629849554840691D+0 B=0.2767731148783578D+0 V=0.2967639918918702D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4014948081992087D+0 B=0.3146542308245309D+0 V=0.3035900684660351D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4389818379260225D+0 B=0.3519196415895088D+0 V=0.3087338237298308D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4752331143674377D+0 B=0.3883050984023654D+0 V=0.3124608838860167D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5100457318374018D+0 B=0.4235613423908649D+0 V=0.3150084294226743D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5432238388954868D+0 B=0.4574484717196220D+0 V=0.3165958398598402D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5745758685072442D+0 B=0.4897311639255524D+0 V=0.3174320440957372D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1723981437592809D+0 B=0.3010630597881105D-1 V=0.2182188909812599D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2149553257844597D+0 B=0.6326031554204694D-1 V=0.2399727933921445D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2573256081247422D+0 B=0.9848566980258631D-1 V=0.2579796133514652D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2993163751238106D+0 B=0.1350835952384266D+0 V=0.2727114052623535D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3407238005148000D+0 B=0.1725184055442181D+0 V=0.2846327656281355D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3813454978483264D+0 B=0.2103559279730725D+0 V=0.2941491102051334D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4209848104423343D+0 B=0.2482278774554860D+0 V=0.3016049492136107D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4594519699996300D+0 B=0.2858099509982883D+0 V=0.3072949726175648D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4965640166185930D+0 B=0.3228075659915428D+0 V=0.3114768142886460D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5321441655571562D+0 B=0.3589459907204151D+0 V=0.3143823673666223D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5660208438582166D+0 B=0.3939630088864310D+0 V=0.3162269764661535D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5980264315964364D+0 B=0.4276029922949089D+0 V=0.3172164663759821D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2644215852350733D+0 B=0.3300939429072552D-1 V=0.2554575398967435D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3090113743443063D+0 B=0.6803887650078501D-1 V=0.2701704069135677D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3525871079197808D+0 B=0.1044326136206709D+0 V=0.2823693413468940D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3950418005354029D+0 B=0.1416751597517679D+0 V=0.2922898463214289D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4362475663430163D+0 B=0.1793408610504821D+0 V=0.3001829062162428D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4760661812145854D+0 B=0.2170630750175722D+0 V=0.3062890864542953D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5143551042512103D+0 B=0.2545145157815807D+0 V=0.3108328279264746D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5509709026935597D+0 B=0.2913940101706601D+0 V=0.3140243146201245D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5857711030329428D+0 B=0.3274169910910705D+0 V=0.3160638030977130D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6186149917404392D+0 B=0.3623081329317265D+0 V=0.3171462882206275D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3586894569557064D+0 B=0.3497354386450040D-1 V=0.2812388416031796D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4035266610019441D+0 B=0.7129736739757095D-1 V=0.2912137500288045D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4467775312332510D+0 B=0.1084758620193165D+0 V=0.2993241256502206D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4883638346608543D+0 B=0.1460915689241772D+0 V=0.3057101738983822D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5281908348434601D+0 B=0.1837790832369980D+0 V=0.3105319326251432D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5661542687149311D+0 B=0.2212075390874021D+0 V=0.3139565514428167D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6021450102031452D+0 B=0.2580682841160985D+0 V=0.3161543006806366D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6360520783610050D+0 B=0.2940656362094121D+0 V=0.3172985960613294D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4521611065087196D+0 B=0.3631055365867002D-1 V=0.2989400336901431D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4959365651560963D+0 B=0.7348318468484350D-1 V=0.3054555883947677D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5376815804038283D+0 B=0.1111087643812648D+0 V=0.3104764960807702D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5773314480243768D+0 B=0.1488226085145408D+0 V=0.3141015825977616D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6148113245575056D+0 B=0.1862892274135151D+0 V=0.3164520621159896D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6500407462842380D+0 B=0.2231909701714456D+0 V=0.3176652305912204D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5425151448707213D+0 B=0.3718201306118944D-1 V=0.3105097161023939D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5841860556907931D+0 B=0.7483616335067346D-1 V=0.3143014117890550D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6234632186851500D+0 B=0.1125990834266120D+0 V=0.3168172866287200D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6602934551848843D+0 B=0.1501303813157619D+0 V=0.3181401865570968D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6278573968375105D+0 B=0.3767559930245720D-1 V=0.3170663659156037D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6665611711264577D+0 B=0.7548443301360158D-1 V=0.3185447944625510D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD3890(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 3890-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.1807395252196920D-4 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.2848008782238827D-3 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.2836065837530581D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1587876419858352D-1 V=0.7013149266673816D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4069193593751206D-1 V=0.1162798021956766D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7025888115257997D-1 V=0.1518728583972105D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1027495450028704D+0 V=0.1798796108216934D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1371457730893426D+0 V=0.2022593385972785D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1727758532671953D+0 V=0.2203093105575464D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2091492038929037D+0 V=0.2349294234299855D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2458813281751915D+0 V=0.2467682058747003D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2826545859450066D+0 V=0.2563092683572224D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3191957291799622D+0 V=0.2639253896763318D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3552621469299578D+0 V=0.2699137479265108D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3906329503406230D+0 V=0.2745196420166739D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4251028614093031D+0 V=0.2779529197397593D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4584777520111870D+0 V=0.2803996086684265D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4905711358710193D+0 V=0.2820302356715842D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5212011669847385D+0 V=0.2830056747491068D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5501878488737995D+0 V=0.2834808950776839D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6025037877479342D+0 V=0.2835282339078929D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6254572689549016D+0 V=0.2833819267065800D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6460107179528248D+0 V=0.2832858336906784D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6639541138154251D+0 V=0.2833268235451244D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6790688515667495D+0 V=0.2835432677029253D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6911338580371512D+0 V=0.2839091722743049D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6999385956126490D+0 V=0.2843308178875841D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7053037748656896D+0 V=0.2846703550533846D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4732224387180115D-1 V=0.1051193406971900D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1202100529326803D+0 V=0.1657871838796974D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2034304820664855D+0 V=0.2064648113714232D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2912285643573002D+0 V=0.2347942745819741D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3802361792726768D+0 V=0.2547775326597726D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4680598511056146D+0 V=0.2686876684847025D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5528151052155599D+0 V=0.2778665755515867D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6329386307803041D+0 V=0.2830996616782929D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8056516651369069D-1 B=0.2363454684003124D-1 V=0.1403063340168372D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1156476077139389D+0 B=0.5191291632545936D-1 V=0.1696504125939477D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1520473382760421D+0 B=0.8322715736994519D-1 V=0.1935787242745390D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1892986699745931D+0 B=0.1165855667993712D+0 V=0.2130614510521968D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2270194446777792D+0 B=0.1513077167409504D+0 V=0.2289381265931048D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2648908185093273D+0 B=0.1868882025807859D+0 V=0.2418630292816186D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3026389259574136D+0 B=0.2229277629776224D+0 V=0.2523400495631193D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3400220296151384D+0 B=0.2590951840746235D+0 V=0.2607623973449605D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3768217953335510D+0 B=0.2951047291750847D+0 V=0.2674441032689209D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4128372900921884D+0 B=0.3307019714169930D+0 V=0.2726432360343356D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4478807131815630D+0 B=0.3656544101087634D+0 V=0.2765787685924545D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4817742034089257D+0 B=0.3997448951939695D+0 V=0.2794428690642224D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5143472814653344D+0 B=0.4327667110812024D+0 V=0.2814099002062895D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5454346213905650D+0 B=0.4645196123532293D+0 V=0.2826429531578994D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5748739313170252D+0 B=0.4948063555703345D+0 V=0.2832983542550884D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1599598738286342D+0 B=0.2792357590048985D-1 V=0.1886695565284976D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1998097412500951D+0 B=0.5877141038139065D-1 V=0.2081867882748234D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2396228952566202D+0 B=0.9164573914691377D-1 V=0.2245148680600796D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2792228341097746D+0 B=0.1259049641962687D+0 V=0.2380370491511872D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3184251107546741D+0 B=0.1610594823400863D+0 V=0.2491398041852455D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3570481164426244D+0 B=0.1967151653460898D+0 V=0.2581632405881230D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3949164710492144D+0 B=0.2325404606175168D+0 V=0.2653965506227417D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4318617293970503D+0 B=0.2682461141151439D+0 V=0.2710857216747087D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4677221009931678D+0 B=0.3035720116011973D+0 V=0.2754434093903659D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5023417939270955D+0 B=0.3382781859197439D+0 V=0.2786579932519380D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5355701836636128D+0 B=0.3721383065625942D+0 V=0.2809011080679474D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5672608451328771D+0 B=0.4049346360466055D+0 V=0.2823336184560987D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5972704202540162D+0 B=0.4364538098633802D+0 V=0.2831101175806309D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2461687022333596D+0 B=0.3070423166833368D-1 V=0.2221679970354546D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2881774566286831D+0 B=0.6338034669281885D-1 V=0.2356185734270703D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3293963604116978D+0 B=0.9742862487067941D-1 V=0.2469228344805590D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3697303822241377D+0 B=0.1323799532282290D+0 V=0.2562726348642046D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4090663023135127D+0 B=0.1678497018129336D+0 V=0.2638756726753028D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4472819355411712D+0 B=0.2035095105326114D+0 V=0.2699311157390862D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4842513377231437D+0 B=0.2390692566672091D+0 V=0.2746233268403837D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5198477629962928D+0 B=0.2742649818076149D+0 V=0.2781225674454771D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5539453011883145D+0 B=0.3088503806580094D+0 V=0.2805881254045684D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5864196762401251D+0 B=0.3425904245906614D+0 V=0.2821719877004913D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6171484466668390D+0 B=0.3752562294789468D+0 V=0.2830222502333124D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3350337830565727D+0 B=0.3261589934634747D-1 V=0.2457995956744870D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3775773224758284D+0 B=0.6658438928081572D-1 V=0.2551474407503706D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4188155229848973D+0 B=0.1014565797157954D+0 V=0.2629065335195311D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4586805892009344D+0 B=0.1368573320843822D+0 V=0.2691900449925075D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4970895714224235D+0 B=0.1724614851951608D+0 V=0.2741275485754276D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5339505133960747D+0 B=0.2079779381416412D+0 V=0.2778530970122595D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5691665792531440D+0 B=0.2431385788322288D+0 V=0.2805010567646741D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6026387682680377D+0 B=0.2776901883049853D+0 V=0.2822055834031040D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6342676150163307D+0 B=0.3113881356386632D+0 V=0.2831016901243473D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4237951119537067D+0 B=0.3394877848664351D-1 V=0.2624474901131803D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4656918683234929D+0 B=0.6880219556291447D-1 V=0.2688034163039377D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5058857069185980D+0 B=0.1041946859721635D+0 V=0.2738932751287636D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5443204666713996D+0 B=0.1398039738736393D+0 V=0.2777944791242523D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5809298813759742D+0 B=0.1753373381196155D+0 V=0.2806011661660987D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6156416039447128D+0 B=0.2105215793514010D+0 V=0.2824181456597460D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6483801351066604D+0 B=0.2450953312157051D+0 V=0.2833585216577828D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5103616577251688D+0 B=0.3485560643800719D-1 V=0.2738165236962878D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5506738792580681D+0 B=0.7026308631512033D-1 V=0.2778365208203180D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5889573040995292D+0 B=0.1059035061296403D+0 V=0.2807852940418966D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6251641589516930D+0 B=0.1414823925236026D+0 V=0.2827245949674705D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6592414921570178D+0 B=0.1767207908214530D+0 V=0.2837342344829828D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5930314017533384D+0 B=0.3542189339561672D-1 V=0.2809233907610981D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6309812253390175D+0 B=0.7109574040369549D-1 V=0.2829930809742694D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6666296011353230D+0 B=0.1067259792282730D+0 V=0.2841097874111479D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6703715271049922D+0 B=0.3569455268820809D-1 V=0.2843455206008783D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD4334(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 4334-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.1449063022537883D-4 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.2546377329828424D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1462896151831013D-1 V=0.6018432961087496D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3769840812493139D-1 V=0.1002286583263673D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6524701904096891D-1 V=0.1315222931028093D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9560543416134648D-1 V=0.1564213746876724D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1278335898929198D+0 V=0.1765118841507736D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1613096104466031D+0 V=0.1928737099311080D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1955806225745371D+0 V=0.2062658534263270D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2302935218498028D+0 V=0.2172395445953787D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2651584344113027D+0 V=0.2262076188876047D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2999276825183209D+0 V=0.2334885699462397D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3343828669718798D+0 V=0.2393355273179203D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3683265013750518D+0 V=0.2439559200468863D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4015763206518108D+0 V=0.2475251866060002D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4339612026399770D+0 V=0.2501965558158773D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4653180651114582D+0 V=0.2521081407925925D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4954893331080803D+0 V=0.2533881002388081D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5243207068924930D+0 V=0.2541582900848261D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5516590479041704D+0 V=0.2545365737525860D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6012371927804176D+0 V=0.2545726993066799D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6231574466449819D+0 V=0.2544456197465555D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6429416514181271D+0 V=0.2543481596881064D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6604124272943595D+0 V=0.2543506451429194D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6753851470408250D+0 V=0.2544905675493763D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6876717970626160D+0 V=0.2547611407344429D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6970895061319234D+0 V=0.2551060375448869D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7034746912553310D+0 V=0.2554291933816039D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7067017217542295D+0 V=0.2556255710686343D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4382223501131123D-1 V=0.9041339695118195D-4 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1117474077400006D+0 V=0.1438426330079022D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1897153252911440D+0 V=0.1802523089820518D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2724023009910331D+0 V=0.2060052290565496D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3567163308709902D+0 V=0.2245002248967466D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4404784483028087D+0 V=0.2377059847731150D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5219833154161411D+0 V=0.2468118955882525D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5998179868977553D+0 V=0.2525410872966528D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6727803154548222D+0 V=0.2553101409933397D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7476563943166086D-1 B=0.2193168509461185D-1 V=0.1212879733668632D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1075341482001416D+0 B=0.4826419281533887D-1 V=0.1472872881270931D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1416344885203259D+0 B=0.7751191883575742D-1 V=0.1686846601010828D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1766325315388586D+0 B=0.1087558139247680D+0 V=0.1862698414660208D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2121744174481514D+0 B=0.1413661374253096D+0 V=0.2007430956991861D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2479669443408145D+0 B=0.1748768214258880D+0 V=0.2126568125394796D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2837600452294113D+0 B=0.2089216406612073D+0 V=0.2224394603372113D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3193344933193984D+0 B=0.2431987685545972D+0 V=0.2304264522673135D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3544935442438745D+0 B=0.2774497054377770D+0 V=0.2368854288424087D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3890571932288154D+0 B=0.3114460356156915D+0 V=0.2420352089461772D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4228581214259090D+0 B=0.3449806851913012D+0 V=0.2460597113081295D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4557387211304052D+0 B=0.3778618641248256D+0 V=0.2491181912257687D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4875487950541643D+0 B=0.4099086391698978D+0 V=0.2513528194205857D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5181436529962997D+0 B=0.4409474925853973D+0 V=0.2528943096693220D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5473824095600661D+0 B=0.4708094517711291D+0 V=0.2538660368488136D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5751263398976174D+0 B=0.4993275140354637D+0 V=0.2543868648299022D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1489515746840028D+0 B=0.2599381993267017D-1 V=0.1642595537825183D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1863656444351767D+0 B=0.5479286532462190D-1 V=0.1818246659849308D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2238602880356348D+0 B=0.8556763251425254D-1 V=0.1966565649492420D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2612723375728160D+0 B=0.1177257802267011D+0 V=0.2090677905657991D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2984332990206190D+0 B=0.1508168456192700D+0 V=0.2193820409510504D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3351786584663333D+0 B=0.1844801892177727D+0 V=0.2278870827661928D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3713505522209120D+0 B=0.2184145236087598D+0 V=0.2348283192282090D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4067981098954663D+0 B=0.2523590641486229D+0 V=0.2404139755581477D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4413769993687534D+0 B=0.2860812976901373D+0 V=0.2448227407760734D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4749487182516394D+0 B=0.3193686757808996D+0 V=0.2482110455592573D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5073798105075426D+0 B=0.3520226949547602D+0 V=0.2507192397774103D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5385410448878654D+0 B=0.3838544395667890D+0 V=0.2524765968534880D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5683065353670530D+0 B=0.4146810037640963D+0 V=0.2536052388539425D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5965527620663510D+0 B=0.4443224094681121D+0 V=0.2542230588033068D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2299227700856157D+0 B=0.2865757664057584D-1 V=0.1944817013047896D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2695752998553267D+0 B=0.5923421684485993D-1 V=0.2067862362746635D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3086178716611389D+0 B=0.9117817776057715D-1 V=0.2172440734649114D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3469649871659077D+0 B=0.1240593814082605D+0 V=0.2260125991723423D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3845153566319655D+0 B=0.1575272058259175D+0 V=0.2332655008689523D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4211600033403215D+0 B=0.1912845163525413D+0 V=0.2391699681532458D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4567867834329882D+0 B=0.2250710177858171D+0 V=0.2438801528273928D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4912829319232061D+0 B=0.2586521303440910D+0 V=0.2475370504260665D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5245364793303812D+0 B=0.2918112242865407D+0 V=0.2502707235640574D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5564369788915756D+0 B=0.3243439239067890D+0 V=0.2522031701054241D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5868757697775287D+0 B=0.3560536787835351D+0 V=0.2534511269978784D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6157458853519617D+0 B=0.3867480821242581D+0 V=0.2541284914955151D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3138461110672113D+0 B=0.3051374637507278D-1 V=0.2161509250688394D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3542495872050569D+0 B=0.6237111233730755D-1 V=0.2248778513437852D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3935751553120181D+0 B=0.9516223952401907D-1 V=0.2322388803404617D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4317634668111147D+0 B=0.1285467341508517D+0 V=0.2383265471001355D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4687413842250821D+0 B=0.1622318931656033D+0 V=0.2432476675019525D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5044274237060283D+0 B=0.1959581153836453D+0 V=0.2471122223750674D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5387354077925727D+0 B=0.2294888081183837D+0 V=0.2500291752486870D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5715768898356105D+0 B=0.2626031152713945D+0 V=0.2521055942764682D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6028627200136111D+0 B=0.2950904075286713D+0 V=0.2534472785575503D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6325039812653463D+0 B=0.3267458451113286D+0 V=0.2541599713080121D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3981986708423407D+0 B=0.3183291458749821D-1 V=0.2317380975862936D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4382791182133300D+0 B=0.6459548193880908D-1 V=0.2378550733719775D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4769233057218166D+0 B=0.9795757037087952D-1 V=0.2428884456739118D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5140823911194238D+0 B=0.1316307235126655D+0 V=0.2469002655757292D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5496977833862983D+0 B=0.1653556486358704D+0 V=0.2499657574265851D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5837047306512727D+0 B=0.1988931724126510D+0 V=0.2521676168486082D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6160349566926879D+0 B=0.2320174581438950D+0 V=0.2535935662645334D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6466185353209440D+0 B=0.2645106562168662D+0 V=0.2543356743363214D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4810835158795404D+0 B=0.3275917807743992D-1 V=0.2427353285201535D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5199925041324341D+0 B=0.6612546183967181D-1 V=0.2468258039744386D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5571717692207494D+0 B=0.9981498331474143D-1 V=0.2500060956440310D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5925789250836378D+0 B=0.1335687001410374D+0 V=0.2523238365420979D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6261658523859670D+0 B=0.1671444402896463D+0 V=0.2538399260252846D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6578811126669331D+0 B=0.2003106382156076D+0 V=0.2546255927268069D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5609624612998100D+0 B=0.3337500940231335D-1 V=0.2500583360048449D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5979959659984670D+0 B=0.6708750335901803D-1 V=0.2524777638260203D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6330523711054002D+0 B=0.1008792126424850D+0 V=0.2540951193860656D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6660960998103972D+0 B=0.1345050343171794D+0 V=0.2549524085027472D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6365384364585819D+0 B=0.3372799460737052D-1 V=0.2542569507009158D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6710994302899275D+0 B=0.6755249309678028D-1 V=0.2552114127580376D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD4802(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 4802-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.9687521879420705D-4 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.2307897895367918D-3 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.2297310852498558D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2335728608887064D-1 V=0.7386265944001919D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4352987836550653D-1 V=0.8257977698542210D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6439200521088801D-1 V=0.9706044762057630D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9003943631993181D-1 V=0.1302393847117003D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1196706615548473D+0 V=0.1541957004600968D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1511715412838134D+0 V=0.1704459770092199D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1835982828503801D+0 V=0.1827374890942906D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2165081259155405D+0 V=0.1926360817436107D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2496208720417563D+0 V=0.2008010239494833D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2827200673567900D+0 V=0.2075635983209175D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3156190823994346D+0 V=0.2131306638690909D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3481476793749115D+0 V=0.2176562329937335D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3801466086947226D+0 V=0.2212682262991018D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4114652119634011D+0 V=0.2240799515668565D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4419598786519751D+0 V=0.2261959816187525D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4714925949329543D+0 V=0.2277156368808855D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4999293972879466D+0 V=0.2287351772128336D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5271387221431248D+0 V=0.2293490814084085D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5529896780837761D+0 V=0.2296505312376273D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6000856099481712D+0 V=0.2296793832318756D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6210562192785175D+0 V=0.2295785443842974D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6401165879934240D+0 V=0.2295017931529102D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6571144029244334D+0 V=0.2295059638184868D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6718910821718863D+0 V=0.2296232343237362D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6842845591099010D+0 V=0.2298530178740771D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6941353476269816D+0 V=0.2301579790280501D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7012965242212991D+0 V=0.2304690404996513D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7056471428242644D+0 V=0.2307027995907102D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4595557643585895D-1 V=0.9312274696671092D-4 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1049316742435023D+0 V=0.1199919385876926D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1773548879549274D+0 V=0.1598039138877690D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2559071411236127D+0 V=0.1822253763574900D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3358156837985898D+0 V=0.1988579593655040D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4155835743763893D+0 V=0.2112620102533307D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4937894296167472D+0 V=0.2201594887699007D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5691569694793316D+0 V=0.2261622590895036D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6405840854894251D+0 V=0.2296458453435705D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7345133894143348D-1 B=0.2177844081486067D-1 V=0.1006006990267000D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1009859834044931D+0 B=0.4590362185775188D-1 V=0.1227676689635876D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1324289619748758D+0 B=0.7255063095690877D-1 V=0.1467864280270117D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1654272109607127D+0 B=0.1017825451960684D+0 V=0.1644178912101232D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1990767186776461D+0 B=0.1325652320980364D+0 V=0.1777664890718961D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2330125945523278D+0 B=0.1642765374496765D+0 V=0.1884825664516690D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2670080611108287D+0 B=0.1965360374337889D+0 V=0.1973269246453848D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3008753376294316D+0 B=0.2290726770542238D+0 V=0.2046767775855328D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3344475596167860D+0 B=0.2616645495370823D+0 V=0.2107600125918040D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3675709724070786D+0 B=0.2941150728843141D+0 V=0.2157416362266829D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4001000887587812D+0 B=0.3262440400919066D+0 V=0.2197557816920721D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4318956350436028D+0 B=0.3578835350611916D+0 V=0.2229192611835437D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4628239056795531D+0 B=0.3888751854043678D+0 V=0.2253385110212775D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4927563229773636D+0 B=0.4190678003222840D+0 V=0.2271137107548774D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5215687136707969D+0 B=0.4483151836883852D+0 V=0.2283414092917525D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5491402346984905D+0 B=0.4764740676087880D+0 V=0.2291161673130077D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5753520160126075D+0 B=0.5034021310998277D+0 V=0.2295313908576598D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1388326356417754D+0 B=0.2435436510372806D-1 V=0.1438204721359031D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1743686900537244D+0 B=0.5118897057342652D-1 V=0.1607738025495257D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2099737037950268D+0 B=0.8014695048539634D-1 V=0.1741483853528379D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2454492590908548D+0 B=0.1105117874155699D+0 V=0.1851918467519151D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2807219257864278D+0 B=0.1417950531570966D+0 V=0.1944628638070613D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3156842271975842D+0 B=0.1736604945719597D+0 V=0.2022495446275152D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3502090945177752D+0 B=0.2058466324693981D+0 V=0.2087462382438514D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3841684849519686D+0 B=0.2381284261195919D+0 V=0.2141074754818308D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4174372367906016D+0 B=0.2703031270422569D+0 V=0.2184640913748162D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4498926465011892D+0 B=0.3021845683091309D+0 V=0.2219309165220329D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4814146229807701D+0 B=0.3335993355165720D+0 V=0.2246123118340624D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5118863625734701D+0 B=0.3643833735518232D+0 V=0.2266062766915125D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5411947455119144D+0 B=0.3943789541958179D+0 V=0.2280072952230796D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5692301500357246D+0 B=0.4234320144403542D+0 V=0.2289082025202583D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5958857204139576D+0 B=0.4513897947419260D+0 V=0.2294012695120025D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2156270284785766D+0 B=0.2681225755444491D-1 V=0.1722434488736947D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2532385054909710D+0 B=0.5557495747805614D-1 V=0.1830237421455091D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2902564617771537D+0 B=0.8569368062950249D-1 V=0.1923855349997633D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3266979823143256D+0 B=0.1167367450324135D+0 V=0.2004067861936271D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3625039627493614D+0 B=0.1483861994003304D+0 V=0.2071817297354263D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3975838937548699D+0 B=0.1803821503011405D+0 V=0.2128250834102103D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4318396099009774D+0 B=0.2124962965666424D+0 V=0.2174513719440102D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4651706555732742D+0 B=0.2445221837805913D+0 V=0.2211661839150214D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4974752649620969D+0 B=0.2762701224322987D+0 V=0.2240665257813102D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5286517579627517D+0 B=0.3075627775211328D+0 V=0.2262439516632620D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5586001195731895D+0 B=0.3382311089826877D+0 V=0.2277874557231869D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5872229902021319D+0 B=0.3681108834741399D+0 V=0.2287854314454994D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6144258616235123D+0 B=0.3970397446872839D+0 V=0.2293268499615575D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2951676508064861D+0 B=0.2867499538750441D-1 V=0.1912628201529828D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3335085485472725D+0 B=0.5867879341903510D-1 V=0.1992499672238701D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3709561760636381D+0 B=0.8961099205022284D-1 V=0.2061275533454027D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4074722861667498D+0 B=0.1211627927626297D+0 V=0.2119318215968572D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4429923648839117D+0 B=0.1530748903554898D+0 V=0.2167416581882652D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4774428052721736D+0 B=0.1851176436721877D+0 V=0.2206430730516600D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5107446539535904D+0 B=0.2170829107658179D+0 V=0.2237186938699523D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5428151370542935D+0 B=0.2487786689026271D+0 V=0.2260480075032884D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5735699292556964D+0 B=0.2800239952795016D+0 V=0.2277098884558542D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6029253794562866D+0 B=0.3106445702878119D+0 V=0.2287845715109671D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6307998987073145D+0 B=0.3404689500841194D+0 V=0.2293547268236294D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3752652273692719D+0 B=0.2997145098184479D-1 V=0.2056073839852528D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4135383879344028D+0 B=0.6086725898678011D-1 V=0.2114235865831876D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4506113885153907D+0 B=0.9238849548435643D-1 V=0.2163175629770551D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4864401554606072D+0 B=0.1242786603851851D+0 V=0.2203392158111650D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5209708076611709D+0 B=0.1563086731483386D+0 V=0.2235473176847839D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5541422135830122D+0 B=0.1882696509388506D+0 V=0.2260024141501235D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5858880915113817D+0 B=0.2199672979126059D+0 V=0.2277675929329182D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6161399390603444D+0 B=0.2512165482924867D+0 V=0.2289102112284834D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6448296482255090D+0 B=0.2818368701871888D+0 V=0.2295027954625118D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4544796274917948D+0 B=0.3088970405060312D-1 V=0.2161281589879992D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4919389072146628D+0 B=0.6240947677636835D-1 V=0.2201980477395102D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5279313026985183D+0 B=0.9430706144280313D-1 V=0.2234952066593166D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5624169925571135D+0 B=0.1263547818770374D+0 V=0.2260540098520838D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5953484627093287D+0 B=0.1583430788822594D+0 V=0.2279157981899988D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6266730715339185D+0 B=0.1900748462555988D+0 V=0.2291296918565571D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6563363204278871D+0 B=0.2213599519592567D+0 V=0.2297533752536649D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5314574716585696D+0 B=0.3152508811515374D-1 V=0.2234927356465995D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5674614932298185D+0 B=0.6343865291465561D-1 V=0.2261288012985219D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6017706004970264D+0 B=0.9551503504223951D-1 V=0.2280818160923688D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6343471270264178D+0 B=0.1275440099801196D+0 V=0.2293773295180159D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6651494599127802D+0 B=0.1593252037671960D+0 V=0.2300528767338634D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6050184986005704D+0 B=0.3192538338496105D-1 V=0.2281893855065666D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6390163550880400D+0 B=0.6402824353962306D-1 V=0.2295720444840727D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6711199107088448D+0 B=0.9609805077002909D-1 V=0.2303227649026753D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6741354429572275D+0 B=0.3211853196273233D-1 V=0.2304831913227114D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD5294(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 5294-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.9080510764308163D-4 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.2084824361987793D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2303261686261450D-1 V=0.5011105657239616D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3757208620162394D-1 V=0.5942520409683854D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5821912033821852D-1 V=0.9564394826109721D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8403127529194872D-1 V=0.1185530657126338D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1122927798060578D+0 V=0.1364510114230331D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1420125319192987D+0 V=0.1505828825605415D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1726396437341978D+0 V=0.1619298749867023D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2038170058115696D+0 V=0.1712450504267789D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2352849892876508D+0 V=0.1789891098164999D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2668363354312461D+0 V=0.1854474955629795D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2982941279900452D+0 V=0.1908148636673661D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3295002922087076D+0 V=0.1952377405281833D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3603094918363593D+0 V=0.1988349254282232D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3905857895173920D+0 V=0.2017079807160050D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4202005758160837D+0 V=0.2039473082709094D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4490310061597227D+0 V=0.2056360279288953D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4769586160311491D+0 V=0.2068525823066865D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5038679887049750D+0 V=0.2076724877534488D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5296454286519961D+0 V=0.2081694278237885D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5541776207164850D+0 V=0.2084157631219326D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5990467321921213D+0 V=0.2084381531128593D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6191467096294587D+0 V=0.2083476277129307D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6375251212901849D+0 V=0.2082686194459732D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6540514381131168D+0 V=0.2082475686112415D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6685899064391510D+0 V=0.2083139860289915D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6810013009681648D+0 V=0.2084745561831237D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6911469578730340D+0 V=0.2087091313375890D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6988956915141736D+0 V=0.2089718413297697D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7041335794868720D+0 V=0.2092003303479793D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7067754398018567D+0 V=0.2093336148263241D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3840368707853623D-1 V=0.7591708117365267D-4 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9835485954117399D-1 V=0.1083383968169186D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1665774947612998D+0 V=0.1403019395292510D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2405702335362910D+0 V=0.1615970179286436D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3165270770189046D+0 V=0.1771144187504911D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3927386145645443D+0 V=0.1887760022988168D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4678825918374656D+0 V=0.1973474670768214D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5408022024266935D+0 V=0.2033787661234659D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6104967445752438D+0 V=0.2072343626517331D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6760910702685738D+0 V=0.2091177834226918D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6655644120217392D-1 B=0.1936508874588424D-1 V=0.9316684484675566D-4 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9446246161270182D-1 B=0.4252442002115869D-1 V=0.1116193688682976D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1242651925452509D+0 B=0.6806529315354374D-1 V=0.1298623551559414D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1553438064846751D+0 B=0.9560957491205369D-1 V=0.1450236832456426D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1871137110542670D+0 B=0.1245931657452888D+0 V=0.1572719958149914D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2192612628836257D+0 B=0.1545385828778978D+0 V=0.1673234785867195D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2515682807206955D+0 B=0.1851004249723368D+0 V=0.1756860118725188D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2838535866287290D+0 B=0.2160182608272384D+0 V=0.1826776290439367D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3159578817528521D+0 B=0.2470799012277111D+0 V=0.1885116347992865D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3477370882791392D+0 B=0.2781014208986402D+0 V=0.1933457860170574D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3790576960890540D+0 B=0.3089172523515731D+0 V=0.1973060671902064D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4097938317810200D+0 B=0.3393750055472244D+0 V=0.2004987099616311D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4398256572859637D+0 B=0.3693322470987730D+0 V=0.2030170909281499D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4690384114718480D+0 B=0.3986541005609877D+0 V=0.2049461460119080D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4973216048301053D+0 B=0.4272112491408562D+0 V=0.2063653565200186D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5245681526132446D+0 B=0.4548781735309936D+0 V=0.2073507927381027D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5506733911803888D+0 B=0.4815315355023251D+0 V=0.2079764593256122D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5755339829522475D+0 B=0.5070486445801855D+0 V=0.2083150534968778D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1305472386056362D+0 B=0.2284970375722366D-1 V=0.1262715121590664D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1637327908216477D+0 B=0.4812254338288384D-1 V=0.1414386128545972D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1972734634149637D+0 B=0.7531734457511935D-1 V=0.1538740401313898D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2308694653110130D+0 B=0.1039043639882017D+0 V=0.1642434942331432D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2643899218338160D+0 B=0.1334526587117626D+0 V=0.1729790609237496D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2977171599622171D+0 B=0.1636414868936382D+0 V=0.1803505190260828D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3307293903032310D+0 B=0.1942195406166568D+0 V=0.1865475350079657D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3633069198219073D+0 B=0.2249752879943753D+0 V=0.1917182669679069D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3953346955922727D+0 B=0.2557218821820032D+0 V=0.1959851709034382D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4267018394184914D+0 B=0.2862897925213193D+0 V=0.1994529548117882D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4573009622571704D+0 B=0.3165224536636518D+0 V=0.2022138911146548D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4870279559856109D+0 B=0.3462730221636496D+0 V=0.2043518024208592D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5157819581450322D+0 B=0.3754016870282835D+0 V=0.2059450313018110D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5434651666465393D+0 B=0.4037733784993613D+0 V=0.2070685715318472D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5699823887764627D+0 B=0.4312557784139123D+0 V=0.2077955310694373D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5952403350947741D+0 B=0.4577175367122110D+0 V=0.2081980387824712D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2025152599210369D+0 B=0.2520253617719557D-1 V=0.1521318610377956D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2381066653274425D+0 B=0.5223254506119000D-1 V=0.1622772720185755D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2732823383651612D+0 B=0.8060669688588620D-1 V=0.1710498139420709D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3080137692611118D+0 B=0.1099335754081255D+0 V=0.1785911149448736D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3422405614587601D+0 B=0.1399120955959857D+0 V=0.1850125313687736D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3758808773890420D+0 B=0.1702977801651705D+0 V=0.1904229703933298D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4088458383438932D+0 B=0.2008799256601680D+0 V=0.1949259956121987D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4410450550841152D+0 B=0.2314703052180836D+0 V=0.1986161545363960D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4723879420561312D+0 B=0.2618972111375892D+0 V=0.2015790585641370D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5027843561874343D+0 B=0.2920013195600270D+0 V=0.2038934198707418D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5321453674452458D+0 B=0.3216322555190551D+0 V=0.2056334060538251D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5603839113834030D+0 B=0.3506456615934198D+0 V=0.2068705959462289D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5874150706875146D+0 B=0.3789007181306267D+0 V=0.2076753906106002D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6131559381660038D+0 B=0.4062580170572782D+0 V=0.2081179391734803D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2778497016394506D+0 B=0.2696271276876226D-1 V=0.1700345216228943D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3143733562261912D+0 B=0.5523469316960465D-1 V=0.1774906779990410D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3501485810261827D+0 B=0.8445193201626464D-1 V=0.1839659377002642D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3851430322303653D+0 B=0.1143263119336083D+0 V=0.1894987462975169D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4193013979470415D+0 B=0.1446177898344475D+0 V=0.1941548809452595D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4525585960458567D+0 B=0.1751165438438091D+0 V=0.1980078427252384D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4848447779622947D+0 B=0.2056338306745660D+0 V=0.2011296284744488D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5160871208276894D+0 B=0.2359965487229226D+0 V=0.2035888456966776D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5462112185696926D+0 B=0.2660430223139146D+0 V=0.2054516325352142D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5751425068101757D+0 B=0.2956193664498032D+0 V=0.2067831033092635D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6028073872853596D+0 B=0.3245763905312779D+0 V=0.2076485320284876D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6291338275278409D+0 B=0.3527670026206972D+0 V=0.2081141439525255D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3541797528439391D+0 B=0.2823853479435550D-1 V=0.1834383015469222D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3908234972074657D+0 B=0.5741296374713106D-1 V=0.1889540591777677D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4264408450107590D+0 B=0.8724646633650199D-1 V=0.1936677023597375D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4609949666553286D+0 B=0.1175034422915616D+0 V=0.1976176495066504D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4944389496536006D+0 B=0.1479755652628428D+0 V=0.2008536004560983D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5267194884346086D+0 B=0.1784740659484352D+0 V=0.2034280351712291D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5577787810220990D+0 B=0.2088245700431244D+0 V=0.2053944466027758D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5875563763536670D+0 B=0.2388628136570763D+0 V=0.2068077642882360D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6159910016391269D+0 B=0.2684308928769185D+0 V=0.2077250949661599D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6430219602956268D+0 B=0.2973740761960252D+0 V=0.2082062440705320D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4300647036213646D+0 B=0.2916399920493977D-1 V=0.1934374486546626D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4661486308935531D+0 B=0.5898803024755659D-1 V=0.1974107010484300D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5009658555287261D+0 B=0.8924162698525409D-1 V=0.2007129290388658D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5344824270447704D+0 B=0.1197185199637321D+0 V=0.2033736947471293D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5666575997416371D+0 B=0.1502300756161382D+0 V=0.2054287125902493D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5974457471404752D+0 B=0.1806004191913564D+0 V=0.2069184936818894D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6267984444116886D+0 B=0.2106621764786252D+0 V=0.2078883689808782D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6546664713575417D+0 B=0.2402526932671914D+0 V=0.2083886366116359D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5042711004437253D+0 B=0.2982529203607657D-1 V=0.2006593275470817D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5392127456774380D+0 B=0.6008728062339922D-1 V=0.2033728426135397D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5726819437668618D+0 B=0.9058227674571398D-1 V=0.2055008781377608D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6046469254207278D+0 B=0.1211219235803400D+0 V=0.2070651783518502D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6350716157434952D+0 B=0.1515286404791580D+0 V=0.2080953335094320D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6639177679185454D+0 B=0.1816314681255552D+0 V=0.2086284998988521D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5757276040972253D+0 B=0.3026991752575440D-1 V=0.2055549387644668D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6090265823139755D+0 B=0.6078402297870770D-1 V=0.2071871850267654D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6406735344387661D+0 B=0.9135459984176636D-1 V=0.2082856600431965D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6706397927793709D+0 B=0.1218024155966590D+0 V=0.2088705858819358D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6435019674426665D+0 B=0.3052608357660639D-1 V=0.2083995867536322D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6747218676375681D+0 B=0.6112185773983089D-1 V=0.2090509712889637D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE LD5810(X,Y,Z,W,N) REAL*8 X(*) REAL*8 Y(*) REAL*8 Z(*) REAL*8 W(*) INTEGER N REAL*8 A,B,V CVW CVW LEBEDEV 5810-POINT ANGULAR GRID CVW chvd chvd This subroutine is part of a set of subroutines that generate chvd Lebedev grids [1-6] for integration on a sphere. The original chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and chvd translated into fortran by Dr. Christoph van Wuellen. chvd This subroutine was translated using a C to fortran77 conversion chvd tool written by Dr. Christoph van Wuellen. chvd chvd Users of this code are asked to include reference [1] in their chvd publications, and in the user- and programmers-manuals chvd describing their codes. chvd chvd This code was distributed through CCL (http://www.ccl.net/). chvd chvd [1] V.I. Lebedev, and D.N. Laikov chvd "A quadrature formula for the sphere of the 131st chvd algebraic order of accuracy" chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. chvd chvd [2] V.I. Lebedev chvd "A quadrature formula for the sphere of 59th algebraic chvd order of accuracy" chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. chvd chvd [3] V.I. Lebedev, and A.L. Skorokhodov chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. chvd chvd [4] V.I. Lebedev chvd "Spherical quadrature formulas exact to orders 25-29" chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. chvd chvd [5] V.I. Lebedev chvd "Quadratures on a sphere" chvd Computational Mathematics and Mathematical Physics, Vol. 16, chvd 1976, pp. 10-24. chvd chvd [6] V.I. Lebedev chvd "Values of the nodes and weights of ninth to seventeenth chvd order Gauss-Markov quadrature formulae invariant under the chvd octahedron group with inversion" chvd Computational Mathematics and Mathematical Physics, Vol. 15, chvd 1975, pp. 44-51. chvd N=1 V=0.9735347946175486D-5 Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.1907581241803167D-3 Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) V=0.1901059546737578D-3 Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1182361662400277D-1 V=0.3926424538919212D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3062145009138958D-1 V=0.6667905467294382D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5329794036834243D-1 V=0.8868891315019135D-4 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7848165532862220D-1 V=0.1066306000958872D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1054038157636201D+0 V=0.1214506743336128D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1335577797766211D+0 V=0.1338054681640871D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1625769955502252D+0 V=0.1441677023628504D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1921787193412792D+0 V=0.1528880200826557D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2221340534690548D+0 V=0.1602330623773609D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2522504912791132D+0 V=0.1664102653445244D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2823610860679697D+0 V=0.1715845854011323D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3123173966267560D+0 V=0.1758901000133069D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3419847036953789D+0 V=0.1794382485256736D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3712386456999758D+0 V=0.1823238106757407D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3999627649876828D+0 V=0.1846293252959976D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4280466458648093D+0 V=0.1864284079323098D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4553844360185711D+0 V=0.1877882694626914D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4818736094437834D+0 V=0.1887716321852025D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5074138709260629D+0 V=0.1894381638175673D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5319061304570707D+0 V=0.1898454899533629D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5552514978677286D+0 V=0.1900497929577815D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5981009025246183D+0 V=0.1900671501924092D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6173990192228116D+0 V=0.1899837555533510D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6351365239411131D+0 V=0.1899014113156229D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6512010228227200D+0 V=0.1898581257705106D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6654758363948120D+0 V=0.1898804756095753D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6778410414853370D+0 V=0.1899793610426402D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6881760887484110D+0 V=0.1901464554844117D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6963645267094598D+0 V=0.1903533246259542D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7023010617153579D+0 V=0.1905556158463228D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.7059004636628753D+0 V=0.1907037155663528D-3 Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3552470312472575D-1 V=0.5992997844249967D-4 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.9151176620841283D-1 V=0.9749059382456978D-4 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1566197930068980D+0 V=0.1241680804599158D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2265467599271907D+0 V=0.1437626154299360D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2988242318581361D+0 V=0.1584200054793902D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3717482419703886D+0 V=0.1694436550982744D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4440094491758889D+0 V=0.1776617014018108D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5145337096756642D+0 V=0.1836132434440077D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5824053672860230D+0 V=0.1876494727075983D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6468283961043370D+0 V=0.1899906535336482D-3 Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6095964259104373D-1 B=0.1787828275342931D-1 V=0.8143252820767350D-4 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.8811962270959388D-1 B=0.3953888740792096D-1 V=0.9998859890887728D-4 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1165936722428831D+0 B=0.6378121797722990D-1 V=0.1156199403068359D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1460232857031785D+0 B=0.8985890813745037D-1 V=0.1287632092635513D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1761197110181755D+0 B=0.1172606510576162D+0 V=0.1398378643365139D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2066471190463718D+0 B=0.1456102876970995D+0 V=0.1491876468417391D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2374076026328152D+0 B=0.1746153823011775D+0 V=0.1570855679175456D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2682305474337051D+0 B=0.2040383070295584D+0 V=0.1637483948103775D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2989653312142369D+0 B=0.2336788634003698D+0 V=0.1693500566632843D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3294762752772209D+0 B=0.2633632752654219D+0 V=0.1740322769393633D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3596390887276086D+0 B=0.2929369098051601D+0 V=0.1779126637278296D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3893383046398812D+0 B=0.3222592785275512D+0 V=0.1810908108835412D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4184653789358347D+0 B=0.3512004791195743D+0 V=0.1836529132600190D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4469172319076166D+0 B=0.3796385677684537D+0 V=0.1856752841777379D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4745950813276976D+0 B=0.4074575378263879D+0 V=0.1872270566606832D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5014034601410262D+0 B=0.4345456906027828D+0 V=0.1883722645591307D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5272493404551239D+0 B=0.4607942515205134D+0 V=0.1891714324525297D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5520413051846366D+0 B=0.4860961284181720D+0 V=0.1896827480450146D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5756887237503077D+0 B=0.5103447395342790D+0 V=0.1899628417059528D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1225039430588352D+0 B=0.2136455922655793D-1 V=0.1123301829001669D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1539113217321372D+0 B=0.4520926166137188D-1 V=0.1253698826711277D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1856213098637712D+0 B=0.7086468177864818D-1 V=0.1366266117678531D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2174998728035131D+0 B=0.9785239488772918D-1 V=0.1462736856106918D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2494128336938330D+0 B=0.1258106396267210D+0 V=0.1545076466685412D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2812321562143480D+0 B=0.1544529125047001D+0 V=0.1615096280814007D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3128372276456111D+0 B=0.1835433512202753D+0 V=0.1674366639741759D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3441145160177973D+0 B=0.2128813258619585D+0 V=0.1724225002437900D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3749567714853510D+0 B=0.2422913734880829D+0 V=0.1765810822987288D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4052621732015610D+0 B=0.2716163748391453D+0 V=0.1800104126010751D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4349335453522385D+0 B=0.3007127671240280D+0 V=0.1827960437331284D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4638776641524965D+0 B=0.3294470677216479D+0 V=0.1850140300716308D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4920046410462687D+0 B=0.3576932543699155D+0 V=0.1867333507394938D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5192273554861704D+0 B=0.3853307059757764D+0 V=0.1880178688638289D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5454609081136522D+0 B=0.4122425044452694D+0 V=0.1889278925654758D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5706220661424140D+0 B=0.4383139587781027D+0 V=0.1895213832507346D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5946286755181518D+0 B=0.4634312536300553D+0 V=0.1898548277397420D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.1905370790924295D+0 B=0.2371311537781979D-1 V=0.1349105935937341D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2242518717748009D+0 B=0.4917878059254806D-1 V=0.1444060068369326D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2577190808025936D+0 B=0.7595498960495142D-1 V=0.1526797390930008D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2908724534927187D+0 B=0.1036991083191100D+0 V=0.1598208771406474D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3236354020056219D+0 B=0.1321348584450234D+0 V=0.1659354368615331D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3559267359304543D+0 B=0.1610316571314789D+0 V=0.1711279910946440D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3876637123676956D+0 B=0.1901912080395707D+0 V=0.1754952725601440D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4187636705218842D+0 B=0.2194384950137950D+0 V=0.1791247850802529D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4491449019883107D+0 B=0.2486155334763858D+0 V=0.1820954300877716D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4787270932425445D+0 B=0.2775768931812335D+0 V=0.1844788524548449D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5074315153055574D+0 B=0.3061863786591120D+0 V=0.1863409481706220D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5351810507738336D+0 B=0.3343144718152556D+0 V=0.1877433008795068D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5619001025975381D+0 B=0.3618362729028427D+0 V=0.1887444543705232D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5875144035268046D+0 B=0.3886297583620408D+0 V=0.1894009829375006D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6119507308734495D+0 B=0.4145742277792031D+0 V=0.1897683345035198D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2619733870119463D+0 B=0.2540047186389353D-1 V=0.1517327037467653D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.2968149743237949D+0 B=0.5208107018543989D-1 V=0.1587740557483543D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3310451504860488D+0 B=0.7971828470885599D-1 V=0.1649093382274097D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3646215567376676D+0 B=0.1080465999177927D+0 V=0.1701915216193265D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3974916785279360D+0 B=0.1368413849366629D+0 V=0.1746847753144065D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4295967403772029D+0 B=0.1659073184763559D+0 V=0.1784555512007570D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4608742854473447D+0 B=0.1950703730454614D+0 V=0.1815687562112174D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4912598858949903D+0 B=0.2241721144376724D+0 V=0.1840864370663302D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5206882758945558D+0 B=0.2530655255406489D+0 V=0.1860676785390006D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5490940914019819D+0 B=0.2816118409731066D+0 V=0.1875690583743703D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5764123302025542D+0 B=0.3096780504593238D+0 V=0.1886453236347225D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6025786004213506D+0 B=0.3371348366394987D+0 V=0.1893501123329645D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6275291964794956D+0 B=0.3638547827694396D+0 V=0.1897366184519868D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3348189479861771D+0 B=0.2664841935537443D-1 V=0.1643908815152736D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.3699515545855295D+0 B=0.5424000066843495D-1 V=0.1696300350907768D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4042003071474669D+0 B=0.8251992715430854D-1 V=0.1741553103844483D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4375320100182624D+0 B=0.1112695182483710D+0 V=0.1780015282386092D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4699054490335947D+0 B=0.1402964116467816D+0 V=0.1812116787077125D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5012739879431952D+0 B=0.1694275117584291D+0 V=0.1838323158085421D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5315874883754966D+0 B=0.1985038235312689D+0 V=0.1859113119837737D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5607937109622117D+0 B=0.2273765660020893D+0 V=0.1874969220221698D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5888393223495521D+0 B=0.2559041492849764D+0 V=0.1886375612681076D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6156705979160163D+0 B=0.2839497251976899D+0 V=0.1893819575809276D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6412338809078123D+0 B=0.3113791060500690D+0 V=0.1897794748256767D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4076051259257167D+0 B=0.2757792290858463D-1 V=0.1738963926584846D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4423788125791520D+0 B=0.5584136834984293D-1 V=0.1777442359873466D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4760480917328258D+0 B=0.8457772087727143D-1 V=0.1810010815068719D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5085838725946297D+0 B=0.1135975846359248D+0 V=0.1836920318248129D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5399513637391218D+0 B=0.1427286904765053D+0 V=0.1858489473214328D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5701118433636380D+0 B=0.1718112740057635D+0 V=0.1875079342496592D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5990240530606021D+0 B=0.2006944855985351D+0 V=0.1887080239102310D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6266452685139695D+0 B=0.2292335090598907D+0 V=0.1894905752176822D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6529320971415942D+0 B=0.2572871512353714D+0 V=0.1898991061200695D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.4791583834610126D+0 B=0.2826094197735932D-1 V=0.1809065016458791D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5130373952796940D+0 B=0.5699871359683649D-1 V=0.1836297121596799D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5456252429628476D+0 B=0.8602712528554394D-1 V=0.1858426916241869D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5768956329682385D+0 B=0.1151748137221281D+0 V=0.1875654101134641D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6068186944699046D+0 B=0.1442811654136362D+0 V=0.1888240751833503D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6353622248024907D+0 B=0.1731930321657680D+0 V=0.1896497383866979D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6624927035731797D+0 B=0.2017619958756061D+0 V=0.1900775530219121D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5484933508028488D+0 B=0.2874219755907391D-1 V=0.1858525041478814D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.5810207682142106D+0 B=0.5778312123713695D-1 V=0.1876248690077947D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6120955197181352D+0 B=0.8695262371439526D-1 V=0.1889404439064607D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6416944284294319D+0 B=0.1160893767057166D+0 V=0.1898168539265290D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6697926391731260D+0 B=0.1450378826743251D+0 V=0.1902779940661772D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6147594390585488D+0 B=0.2904957622341456D-1 V=0.1890125641731815D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6455390026356783D+0 B=0.5823809152617197D-1 V=0.1899434637795751D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6747258588365477D+0 B=0.8740384899884715D-1 V=0.1904520856831751D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) A=0.6772135750395347D+0 B=0.2919946135808105D-1 V=0.1905534498734563D-3 Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) N=N-1 RETURN END SUBROUTINE INERTIA(R,A,TI,N,N0) IMPLICIT REAL*8(A-H,O-Z) DIMENSION R(3,N0),A(3,3),T(3,3),TI(3),CM(3),EE(3) DO 2 I=1,3 CM(I)=0.0d0 DO 3 J=1,N 3 CM(I)=CM(I)+R(I,J) 2 CM(I)=CM(I)/N DO 1 I=1,3 DO 1 J=1,3 T(I,J)=0.0d0 DO 1 IS=1,N 1 T(I,J)=T(I,J)+(R(I,IS)-CM(I))*(R(J,IS)-CM(J)) CALL TRED(3,3,T,A,TI,2,IERR,EE) RETURN C DEL(I,J)=SUM(OVER JS) OF A(I,JS)*A(J,JS) C DIAGONAL TD(I,J) = A(IS,I)*T(IS,JS)*A(JS,j) END SUBROUTINE TRED(N0,N,A,Z,D,IEIG,IERR,E) IMPLICIT REAL*8(A-H,O-Z) DIMENSION A(N0,N0),Z(N0,N0),D(N0),E(N0) IF (IEIG .LT. 0) GO TO 110 DO 100 I = 1, N DO 100 J = 1, I Z(I,J) = A(I,J) 100 CONTINUE 110 ICODE = IABS(IEIG) IF (N .EQ. 1) GO TO 320 DO 300 II = 2, N I = N + 2 - II L = I - 1 H = 0.0D0 SCALE = 0.0D0 IF (L .LT. 2) GO TO 130 DO 120 K = 1, L 120 SCALE = SCALE + DABS(Z(I,K)) IF (DABS(SCALE) .GT. 1.0D-10) GO TO 140 130 E(I) = Z(I,L) GO TO 290 140 DO 150 K = 1, L F = Z(I,K) / SCALE Z(I,K) = F H = H + F * F 150 CONTINUE G = -DSIGN(DSQRT(H),F) E(I) = SCALE * G H = H - F * G Z(I,L) = F - G F = 0.0D0 DO 240 J = 1, L IF (ICODE .EQ. 2) Z(J,I) = Z(I,J) / (SCALE * H) G = 0.0D0 DO 180 K = 1, J 180 G = G + Z(J,K) * Z(I,K) JP1 = J + 1 IF (L .LT. JP1) GO TO 220 DO 200 K = JP1, L 200 G = G + Z(K,J) * Z(I,K) 220 E(J) = G / H F = F + E(J) * Z(I,J) 240 CONTINUE HH = F / (H + H) DO 260 J = 1, L F = Z(I,J) G = E(J) - HH * F E(J) = G DO 260 K = 1, J Z(J,K) = Z(J,K) - F * E(K) - G * Z(I,K) 260 CONTINUE DO 280 K = 1, L 280 Z(I,K) = SCALE * Z(I,K) 290 D(I) = H 300 CONTINUE 320 D(1) = 0.0D0 E(1) = 0.0D0 IF (ICODE .NE. 2) GO TO 600 DO 500 I = 1, N L = I - 1 IF (DABS(D(I)) .LT. 1.0D-10) GO TO 380 DO 360 J = 1, L G = 0.0D0 DO 340 K = 1, L 340 G = G + Z(I,K) * Z(K,J) DO 360 K = 1, L Z(K,J) = Z(K,J) - G * Z(K,I) 360 CONTINUE 380 D(I) = Z(I,I) Z(I,I) = 1.0D0 IF (L .LT. 1) GO TO 500 DO 400 J = 1, L Z(I,J) = 0.0D0 Z(J,I) = 0.0D0 400 CONTINUE 500 CONTINUE 620 CALL TQL (N0,N,Z,D,IERR,ICODE,E) RETURN 600 DO 610 I=1,N 610 D(I) = Z(I,I) GO TO 620 END SUBROUTINE TQL(N0,N,Z,D,IERR,ICODE,E) IMPLICIT REAL*8(A-H,O-Z) DIMENSION Z(N0,N0),D(N0),E(N0) REAL*8 MACHEP EPS = 1.0D0 10 EPS = 0.50D0*EPS TOL1 = EPS + 1.0D0 IF((TOL1.GT.1.0D0).AND.(TOL1-EPS.EQ.1.0D0)) GO TO 10 IF(TOL1-EPS.EQ.1.0D0) EPS = EPS + EPS MACHEP = EPS IERR = 0 IF (N .EQ. 1) GO TO 1001 DO 100 I = 2, N 100 E(I-1) = E(I) F = 0.0D0 B = 0.0D0 E(N) = 0.0D0 DO 240 L = 1, N J = 0 H = MACHEP * (DABS(D(L)) + DABS(E(L))) IF (B .LT. H) B = H DO 110 M = L, N IF (DABS(E(M)) .LE. B) GO TO 120 110 CONTINUE 120 IF (M .EQ. L) GO TO 220 130 IF (J .EQ. 30) GO TO 1000 J = J + 1 L1 = L + 1 G = D(L) P = (D(L1) - G) / (2.0D0 * E(L)) R = DSQRT(P*P+1.0D0) D(L) = E(L) / (P + DSIGN(R,P)) H = G - D(L) DO 140 I = L1, N 140 D(I) = D(I) - H F = F + H P = D(M) C = 1.0D0 S = 0.0D0 MML = M - L DO 200 II = 1, MML I = M - II G = C * E(I) H = C * P IF (DABS(P) .LT. DABS(E(I))) GO TO 150 C = E(I) / P R = DSQRT(C*C+1.0D0) E(I+1) = S * P * R S = C / R C = 1.0D0 / R GO TO 160 150 C = P / E(I) R = DSQRT(C*C+1.0D0) E(I+1) = S * E(I) * R S = 1.0D0 / R C = C * S 160 P = C * D(I) - S * G D(I+1) = H + S * (C * G + S * D(I)) IF (ICODE .NE. 2) GO TO 200 DO 180 K = 1, N H = Z(K,I+1) Z(K,I+1) = S * Z(K,I) + C * H Z(K,I) = C * Z(K,I) - S * H 180 CONTINUE 200 CONTINUE E(L) = S * P D(L) = C * P IF (DABS(E(L)) .GT. B) GO TO 130 220 D(L) = D(L) + F 240 CONTINUE GO TO 1001 1000 IERR = L 1001 RETURN END