program mcub implicit none integer*4 nat,nao,nmo,nor,ndo,nori,nsa,nsb,nmo2,n,ncmm, 1na,nb,ifix,n22,np,n1,n2,nproc,nlim,mo1,mo2,mstart,mend, 1nleb,nmol,nnm,nw0,io1,io2,natt parameter (nor=80,nw0=100) real*8 pi,spt,bohr,gammaau,gammanm,wmin,wmax,w(nw0),gnm, 1v1(3),v2(3),p0(3),ncis,xcis,dcis,wcis,rleb,qt,aes logical lturbo,ld5,lf7,lzmat,ltda,lopen,lbck,lden,lgnm,lgau,lat, 1lnorm,lort,lwrt,lg9,lh11,li13,lro,lt,le,lb,lout,llog,lcis,lleb, 1lfi,lj,ljp,loniom,lpol character*80 ifn real*8,allocatable::cij(:,:),bij(:,:),e(:),be(:),cc(:,:), 1alpha(:,:),rcp(:,:),z(:),xv(:,:),ecij(:),dij(:),cijb(:), 1dl(:,:),r(:,:),ee(:),ev(:),r0v(:),r0l(:), 1eau(:),x(:,:),xau(:,:),am(:),ccs(:,:),ccp(:,:), 1ccd(:,:,:),ccf(:,:,:),cci_G(:,:,:),cci_H(:,:,:),cci_I(:,:,:), 1rcd(:,:) integer*4,allocatable::nop(:),ish(:,:),nib(:),nibd(:),ni(:), 1nid(:),qq(:),aij(:),ebij(:),aijb(:),bijb(:), 1daij(:),dbij(:) character*1 ,allocatable::ty(:,:) character*2 ,allocatable::at(:) common/const/pi,spt,bohr write(6,600) 600 format(/,' Mcub: Generates Gaussian .cub files',/,/, 1 ' Input: MCUB.OPT options',/, 1 ' G.OUT gaussian output',/, 1 ' CAGE.PAR cube definition',/,/, 1 ' Output: ...cub various cubs',/, 1 ' at.txt atomic coordinates in plane',/, 1 ' ex,ey,ez.txt plane intensities',/, 1 ' PO..,AV..,MV.. surface,atom,molecule', 1 ' intensities',/) call init call readopt(ifn,lturbo,nao,nmo,ld5,lf7,lg9,lh11,li13,lzmat, 1ifix,lnorm,lort,lwrt,lden,lbck,gammaau,gammanm,lgau,lgnm,wmin, 1wmax,np,w,gnm,lro,lt,le,lb,v1,v2,p0,n1,n2,nproc,nlim,lout,llog, 1lcis,mo1,mo2,ncis,dcis,xcis,wcis,lleb,nleb,rleb,nmol,lat,lfi,qt, 1aes,lj,ljp,nnm,nw0,loniom,io1,io2,lpol) c Input basis set and orbitals: call getdimensions(nat,nao,nmo,lturbo,ifn,loniom,io1,io2,natt) allocate(cij(nao,nao),bij(nao,nao),e(nao),be(nao),cc(nat,nor), 1alpha(nat,nor),nop(nat),ty(nat,nor),ish(nat,nor),at(nat), 1xv(3,nat),z(nat),rcp(nat,nor),am(nat),ccs(nat,nor),ccp(nat,nor), 1ccd(nat,nor,2),ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28),rcd(nat,nor),qq(nat)) CALL ai(nao,nmo,NAT,cij,bij,e,be,nop,ty,ish,z,xv, 1alpha,cc,nsa,nsb,ndo,nori,rcp,rcd,at,ld5,lf7,lg9,lh11,li13, 1lturbo,ifn,lzmat,am,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,qq, 1loniom,io1,io2,natt) c Input excitations: if(lcis)then call di12(n,nmo,nmo2,ncmm,ndo,mo1,mo2,mstart,mend,e,wcis) else call dimensions(n,ifn,nmo,nmo2,nat,lzmat,lturbo,ltda,ncmm) endif write(6,*)n,' transitions' write(6,*)nmo,' molecular orbitals' if(nmo.eq.0)call report('Stop') write(6,*)nat,' atoms' if(nat.eq.0)call report('Stop') write(6,*)ncmm,' maximum number of Ci coefficients' if(ncmm.eq.0)then n22=nmo2 else n22=ncmm endif write(6,*)n22,' CI dimension' allocate(ecij(2*n22*n),aij(n22*n),ebij(n22*n),dij(n22*n), 1cijb(n22*n),aijb(n22*n),bijb(n22*n),dbij(n22*n),daij(n22*n), 1nib(n),nibd(n),ni(2*n),nid(n),dl(n,3),r(n,3),ee(n),ev(n), 1r0v(n),r0l(n),eau(n),x(3,nat),xau(3,nat)) if(lcis)then call overlap6(nat,nao,ty,xv,nop,alpha,ish, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13) call makemos2(nao,cij,nmo,nproc) call cis(n,na,nb,e,dl,r,eau,ni,natt,ecij,lopen,mstart,mend, 1 aij,ebij,ifn,qq,ndo,nmo,ncis,dcis,xcis,wcis, 1 loniom,io1,io2) else if(lturbo)then call rdtm(qq,x,bohr,xau,na,nb,nmo2,n,nmo, 1 dl,r,r0v,r0l,ee,ev,eau,ni,nid,nat,ecij,lopen, 1 aij,ebij,ifix,nib,cijb,aijb,bijb,lnorm,lort,lwrt) else call readfile(lzmat,qq,x,bohr,xau,na,nb,n22,n, 1 dl,r,r0v,r0l,ee,ev,eau,ni,lden,nid,nat,ecij,lopen, 1 aij,ebij,dij,daij,dbij,ifn,nib, 1 lwrt,nibd,ltda,loniom,io1,io2) if(ltda)call readtda(na,nb,nmo2,n,nmo,ee,ev,eau,ni,lden, 1 nid,ecij,lopen,aij,ebij,dij,daij,dbij,ifix,nib,lnorm,lort,lwrt, 1 nibd,ncmm) call readfchk(ifn,eau,dl,r,n) endif endif c call inibe4 c c electron static density if(lro)call ro2(cij,nao,nat,lopen,qq,xv,ty,nop,ish,ndo,nlim, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha, 1ld5,lf7,lg9,lh11,li13,nproc) c electron dynamic density if(lt)call rod(cij,n,nao,nat,lopen,qq,xv,ty,nop,ish,n22, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha,ni,nlim, 1ld5,lf7,lg9,lh11,li13,w(1),dl,eau,aij,ebij,ecij,gnm,nproc) c electron dynamic current if(lj)call roj(cij,n,nao,nat,lopen,qq,xv,ty,nop,ish,n22, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha,ni,nlim, 1ld5,lf7,lg9,lh11,li13,w(1),dl,eau,aij,ebij,ecij,gnm,nproc) c electron dynamic current and density in plane if(ljp)call rop(cij,n,nao,nat,lopen,qq,xv,ty,nop,ish,n22,n1,n2, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha,ni,nlim,v1,v2,p0, 1ld5,lf7,lg9,lh11,li13,w(1),dl,eau,aij,ebij,ecij,gnm,nproc) c static potential if(lfi)call fid(cij,nao,nat,lopen,qq,xv,ty,nop,ish, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha,nlim,ndo, 1ld5,lf7,lg9,lh11,li13,nproc,lleb,nleb,rleb,qt,aes) c electron field intensity if(le)call eod(cij,n,nao,nat,lopen,qq,xv,ty,nop,ish,n22, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha, 1ld5,lf7,lg9,lh11,li13,w(1),dl,eau,aij,ebij,ecij,gnm,ni,nproc,nlim) c electron field intensity - in a plane if(lb)call eop(cij,n,nao,nat,lopen,xv,ty,nop,ish,n22, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha,n1,n2,p0,v1,v2, 1ld5,lf7,lg9,lh11,li13,nnm,w,dl,eau,aij,ebij,ecij,gnm,ni,qq, 1nproc,nlim,lout,ndo,llog,lleb,nleb,rleb,nmol,lat) end subroutine eop(cij,n,nao,nat,lopen,xv,ty,nop,ish,n22, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha,n1,n2,p0,v1,v2, 1ld5,lf7,lg9,lh11,li13,nnm,w,dl,eau,aij,ebij,ecij,gnm,ni,qq,nproc, 1nlim,lout,ndo,llog,lleb,nleb,rleb,nmol,lat) implicit none integer*4 nor parameter (nor=80) integer*4 nao,nat,nop(*),n1,n2,ia,ix,nproc,nlim,ish(nat,nor),iy,a, 1ixx,n,aij(*),ebij(*),iyy,n22,ni(2*n),qq(nat),i,ndo,nleb,b, 1natl,nls,nmol,nm,im,nnm real*8 cij(nao,nao),xv(3,nat),rox,x,y,z,tav, 1alpha(nat,nor),ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21),bohr, 2cci_I(nat,nor,28),j1,j2,dl(n,3),eau(n),ecij(*),psi,rst, 1gnm,er,ei,v1(3),v2(3),p0(3),dv1,dv2,roav,rleb, 1tavp,tavm,w(*) character*1 ty(nat,nor) character*4 s4 real*8,allocatable::orb(:,:),dr(:,:),di(:,:),plane(:,:),or1(:), 1rxx(:),xll(:),yll(:),zll(:),xs(:),ys(:),zs(:),wll(:),ws(:), 1pl(:,:),wau(:),drw(:,:,:),diw(:,:,:),gau(:),roxw(:),rxxw(:,:) logical lout,lopen,ld5,lf7,lg9,lh11,li13,llog,lleb,lat character*1 xyz(3) data xyz/'x','y','z'/ allocate(wau(nnm),gau(nnm),roxw(nnm)) if(nproc.ne.0)call omp_set_num_threads(nproc) bohr=0.52917705993d0 c w ...excitation frequency in nm c gnm ... narrow bandwidth in nm do 1 ix=1,nnm wau(ix)=1.0d7/w(ix)/219474.0d0 1 gau(ix)=(gnm/w(ix))*wau(ix) tav=0.0d0 tavp=0.0d0 tavm=0.0d0 c atom coordinates relative to this projection call atat(nat,xv,p0,dv1,dv2,qq,v1,v2) write(6,600)nnm 600 format(' Electric field intensity in a plane',/,/, 1 i10,' frequencies (nm):') write(6,601)(w(ix),ix=1,nnm) 601 format(6f11.2) write(6,602) 602 format(10x,' frequencies (au):') write(6,603)(wau(ix),ix=1,nnm) 603 format(6e11.4) write(6,604)gnm,p0,v1,n1,v2,n2 604 format(' d:',f10.2,' nm ',/, 1 ' origin:',3f10.2,' A',/, 1 ' v1:',3f10.2,' A(',i4,' points)',/, 1 ' v2:',3f10.2,' A(',i4,' points)',/) allocate(orb(nao,nao),dr(nao,nao),di(nao,nao),or1(nao), 1drw(nnm,nao,nao),diw(nnm,nao,nao)) if(lopen)then call report('Open shell not implemented') else c loop over light polarizations allocate(plane(n1,n2),pl(n1,n2)) pl=0.0d0 do 102 ixx=1,3 write(6,*)'e'//xyz(ixx)//'.txt' c first frequency stays in dr di: do 8 ix=nnm,1,-1 call mkd(ixx,n,nao,n22,ni,dr,di,wau(ix),eau,gau(ix),dl,aij,ebij, 1 ecij,cij,nproc) do 8 a=1,nao do 8 b=1,nao diw(ix,a,b)=di(a,b) 8 drw(ix,a,b)=dr(a,b) c plane for first freqeuncy only: C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(ix,j1,iy,j2,x,y,z,rox,iyy,orb,er,ei,a, C$OMP+ or1,rst,i,psi) do 3 ix=1,n1 write(6,605)ix 605 format(i5,$) j1=dble(ix-1) do 3 iy=1,n2 j2=dble(iy-1) x=(p0(1)+j1*v1(1)+j2*v2(1))/bohr y=(p0(2)+j1*v1(2)+j2*v2(2))/bohr z=(p0(3)+j1*v1(3)+j2*v2(3))/bohr rox=0.0d0 do 6 iyy=1,3 call gorb(iyy,orb,x,y,z,ty,nao,nat,xv,nop,alpha,ish, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13,nlim) c (er,ei) = (dr,di) x orb: call symmu(nao,er,ei,orb,dr,di) 6 rox=rox+er**2+ei**2 rox=4.0d0*rox if(llog)rox=log(rox+1.0d-99)/log(10.0d0) c determine density at this point if(lout)then call forb(or1,x,y,z,ty,nao,nat,xv,nop,alpha,ish,nlim, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13) rst=0.0d0 do 51 i=1,ndo psi=0.0d0 do 61 a=1,nao 61 psi=psi+cij(i,a)*or1(a) 51 rst=rst+psi**2 rst=rst+rst if(rst.gt.0.02d0)rox=0.0d0 endif pl(ix,iy)=pl(ix,iy)+rox 3 plane(ix,iy)=rox call wrpl('e'//xyz(ixx)//'.txt',n1,n2,dv1,dv2,plane) if(ixx.eq.3)call wrpl('et.txt',n1,n2,dv1,dv2,pl) c lebedev for first freqeuncy only: c lebleblebleblebleblebleblebleblebleblebleblebleblebleblebleb if(lleb)then write(6,698)xyz(ixx) 698 format(/,' Intensity on Lebedev-Laikov surface ',a1) open(9,file='PO'//xyz(ixx)//'.TXT') if(nlim.lt.nat.and.nlim.ne.0)then natl=nlim else natl=nat endif if(ixx.eq.1)then allocate(xll(nleb),yll(nleb),zll(nleb),wll(nleb), 1 xs(nleb*natl),ys(nleb*natl),zs(nleb*natl),ws(nleb*natl)) call fillllpoints(nleb,nat,natl,nls, 1 xll,yll,zll,wll,rleb,xs,ys,zs,ws,xv) endif allocate(rxx(nls)) C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(ia,x,y,z,rox,iyy,orb,er,ei) do 108 ia=1,nls x=xs(ia) y=ys(ia) z=zs(ia) rox=0.0d0 do 63 iyy=1,3 call gorb(iyy,orb,x,y,z,ty,nao,nat,xv,nop,alpha,ish, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13,nlim) call symmu(nao,er,ei,orb,dr,di) 63 rox=rox+er**2+ei**2 rox=4.0d0*rox write(6,595)ia,rox**2 write(9,595)ia,rox**2 595 format(i6,4e12.4) 108 rxx(ia)=ws(ia)*rox**2 close(9) roav=0.0d0 do 109 ia=1,nls 109 roav=roav+rxx(ia) roav=roav/dble(nls) write(6,696)roav tavp=tavp+roav if(ixx.eq.3)write(6,697)tavp/3.0d0 deallocate(rxx) endif c lebleblebleblebleblebleblebleblebleblebleblebleblebleblebleb c c atoms for first freqeuncy only: c aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa if(lat.and.(nlim.lt.nat.and.nlim.ne.0))then write(6,693)xyz(ixx) 693 format(' Intensity on left-out atoms',a1) write(6,694) 694 format(' Atom |Er|^4',/,1x,20(1h-)) open(9,file='AV'//xyz(ixx)//'.TXT') allocate(rxx(nat)) C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(ia,x,y,z,rox,iyy,orb,er,ei) do 103 ia=nlim+1,nat x=xv(1,ia) y=xv(2,ia) z=xv(3,ia) rox=0.0d0 do 62 iyy=1,3 call gorb(iyy,orb,x,y,z,ty,nao,nat,xv,nop,alpha,ish, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13,nlim) call symmu(nao,er,ei,orb,dr,di) 62 rox=rox+er**2+ei**2 rox=4.0d0*rox write(6,695)ia,rox**2 write(9,695)ia,rox**2 695 format(i6,e12.4) 103 rxx(ia)=rox close(9) roav=0.0d0 do 104 ia=nlim+1,nat 104 roav=roav+rxx(ia)**2 roav=roav/dble(nat-nlim) write(6,696)roav deallocate(rxx) 696 format(1x,20(1h-),/,' Average E^4:',e12.4) tav=tav+roav if(ixx.eq.3)write(6,697)tav/3.0d0 697 format(1x,20(1h-),/,' XYZ Average E^4:',e12.4) endif c aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa c molecules for nnm freqeuncies: c mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm if(nmol.ne.0)then nm=(nat-nlim)/nmol write(6,700)nm,xyz(ixx) 700 format(' Intensity inside',i6,' molecules ',a1) write(6,701) 701 format(' Molecule |Er|^4',/,1x,20(1h-)) c atom numbering: 1...nlim gold c nlim+1,nlim+nmol first molecule c nlim+nmol+1,nlim+2nmol second molecule c ....... etc. allocate(rxxw(nm,nnm)) C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(im,ia,x,y,z,roxw,iyy,orb,er,ei,ix,di,dr,a,b) do 105 im=1,nm c center of this molecule x=0.0d0 y=0.0d0 z=0.0d0 do 111 ia=nlim+1+nmol*(im-1),nlim+nmol*im x=x+xv(1,ia) y=y+xv(2,ia) 111 z=z+xv(3,ia) x=x/dble(nmol) y=y/dble(nmol) z=z/dble(nmol) roxw=0.0d0 do 112 iyy=1,3 call gorb(iyy,orb,x,y,z,ty,nao,nat,xv,nop,alpha,ish, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13,nlim) do 112 ix=1,nnm do 9 a=1,nao do 9 b=1,nao di(a,b)=diw(ix,a,b) 9 dr(a,b)=drw(ix,a,b) call symmu(nao,er,ei,orb,dr,di) 112 roxw(ix)=roxw(ix)+er**2+ei**2 write(6,695)im,roxw(1)**2 do 105 ix=1,nnm roxw(ix)=4.0d0*roxw(ix) 105 rxxw(im,ix)=roxw(ix) do 10 ix=1,nnm write(s4,333)ix 333 format(i4) do 11 a=1,len(s4) 11 if(s4(a:a).ne.' ')goto 12 12 open(9,file='MV'//xyz(ixx)//'.'//s4(a:len(s4))//'.TXT') do 113 im=1,nm 113 write(9,695)im,rxxw(im,ix)**2 10 close(9) roav=0.0d0 do 114 im=1,nm 114 roav=roav+rxxw(im,1)**2 roav=roav/dble(nm) write(6,696)roav deallocate(rxxw) tavm=tavm+roav if(ixx.eq.3)write(6,697)tavm/3.0d0 endif c mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm 102 write(6,*) c ixx endif return end subroutine fillllpoints(nleb,nat,natl,nls, 1xll,yll,zll,wll,rleb,xs,ys,zs,ws,xv) implicit none integer*4 nleb,nleba,nls,natl,ia,ip,nat,ja real*8 xll(nleb),yll(nleb),zll(nleb),wll(nleb),rlebau,bohr, 1xs(nleb*natl),ys(nleb*natl),zs(nleb*natl),ws(nleb*natl), 1rleb,rlebau2,x,y,z,xv(3,nat),d2 bohr=0.52917705993d0 call ll(nleb,nleba,0,xll,yll,zll,wll) rlebau=rleb/bohr rlebau2=rlebau**2 nls=0 do 106 ia=1,natl do 106 ip=1,nleba x=xv(1,ia)+xll(ip)*rlebau y=xv(2,ia)+yll(ip)*rlebau z=xv(3,ia)+zll(ip)*rlebau do 107 ja=1,natl if(ja.ne.ia)then d2=(xv(3,ja)-z)**2+(xv(2,ja)-y)**2+(xv(1,ja)-x)**2 if(d2.lt.rlebau2)goto 106 endif 107 continue nls=nls+1 xs(nls)=x ys(nls)=y zs(nls)=z ws(nls)=wll(ip) 106 continue write(6,699)nls,natl*nleba 699 format(i6,' surface points of',i8) open(12,file='SP.X') write(12,1200)nls 1200 format(' Simulated surface points with hydrogens',/,i6) do 110 ip=1,nls 110 write(12,1201)1,xs(ip)*bohr,ys(ip)*bohr,zs(ip)*bohr 1201 format(i6,3f12.6) close(12) write(6,*)'SP.X' return end subroutine eod(cij,n,nao,nat,lopen,qq,xv,ty,nop,ish,n22, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha, 1ld5,lf7,lg9,lh11,li13,w,dl,eau,aij,ebij,ecij,gnm,ni,nproc,nlim) implicit none integer*4 nor parameter (nor=80) integer*4 nao,nat,ii,i3(3),qq(nat),nop(*), 1ish(nat,nor),ix,iy,iz,a,ixx,n,aij(*),ebij(*), 1b,iyy,n22,ni(2*n),nproc,nlim real*8 cij(nao,nao),x0(3),v3(3,3),xv(3,nat),rox,x,y,z, 1alpha(nat,nor),ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28),j1,j2,j3,dl(n,3),eau(n),ecij(*),wau, 1gnm,gau,w,er,ei character*1 ty(nat,nor) real*8,allocatable::rz(:),orb(:,:),dr(:,:),di(:,:) logical lopen,ld5,lf7,lg9,lh11,li13 character*1 xyz(3) data xyz/'x','y','z'/ c w ...excitation frequency in nm c gnm ... narrow bandwidth in nm wau=1.0d7/w/219474.0d0 gau=(gnm/w)*wau call rdc(ii,x0,i3,v3) allocate(rz(i3(3)),orb(nao,nao),dr(nao,nao),di(nao,nao)) if(lopen)then call report('Open shell not implemented') else c loop over light polarizations do 102 ixx=1,3 write(6,*)' Electric field intensity - '//xyz(ixx) call mkd(ixx,n,nao,n22,ni,dr,di,wau,eau,gau,dl,aij,ebij, 1 ecij,cij,nproc) open(12,file='e'//xyz(ixx)//'.cub') call chead(12,' Electric field intensity '//xyz(ixx), 1 nat,x0,i3,v3,xv,qq,' Electron density from Total SCF Density') do 3 ix=1,i3(1) j1=dble(ix-1) do 3 iy=1,i3(2) j2=dble(iy-1) do 31 iz=1,i3(3) j3=dble(iz-1) x=x0(1)+j1*v3(1,1)+j2*v3(2,1)+j3*v3(3,1) y=x0(2)+j1*v3(1,2)+j2*v3(2,2)+j3*v3(3,2) z=x0(3)+j1*v3(1,3)+j2*v3(2,3)+j3*v3(3,3) rox=0.0d0 do 6 iyy=1,3 call gorb(iyy,orb,x,y,z,ty,nao,nat,xv,nop,alpha,ish, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13,nlim) er=0.0d0 ei=0.0d0 do 5 a=1,nao do 5 b=1,nao er=er+dr(a,b)*orb(a,b) 5 ei=ei+di(a,b)*orb(a,b) 6 rox=rox+er**2+ei**2 31 rz(iz)=4.0d0*rox 3 write(12,1214)rz 1214 format(6E13.5) 102 close(12) endif return end subroutine fid(cij,nao,nat,lopen,qq,xv,ty,nop,ish, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha,nlim,ndo, 1ld5,lf7,lg9,lh11,li13,nproc,lleb,nleb,rleb,qt,aes) implicit none integer*4 nor parameter (nor=80) integer*4 nao,nat,i,ia,j,k,ii,i3(3),qq(nat),nop(*),nlim, 1ish(nat,nor),ix,iy,iz,nproc,ndo,natl,nls,nleb,ib,nr real*8 cij(nao,nao),x0(3),v3(3,3),xv(3,nat),x,y,z, 1alpha(nat,nor),ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28),j1,j2,j3,fi,fip,rleb,qt,xa,ya,za,da,db, 1xb,yb,zb,bohr,aes,rms,on real*8,allocatable::xll(:),yll(:),zll(:),wll(:), 1xs(:),ys(:),zs(:),ws(:),m(:,:),mi(:,:),v(:),fis(:), 1xr(:),yr(:),zr(:),qr(:),s(:,:) integer*4,allocatable::cr(:),qqt(:) logical lleb,lex character*1 ty(nat,nor) real*8,allocatable::rz(:,:,:),orb(:,:),d(:,:),rzt(:,:,:) logical lopen,ld5,lf7,lg9,lh11,li13 bohr=0.52917705993d0 call rdc(ii,x0,i3,v3) allocate(rz(i3(1),i3(2),i3(3)),orb(nao,nao),d(nao,nao)) allocate(rzt(i3(1),i3(2),i3(3)),qqt(nat)) if(lopen)then call report('Open shell not implemented') else c loop over light polarizations write(6,*)' Static potential ' open(42,file='pot2.cub') call chead(42,' Potential',nat,x0,i3,v3,xv,qq, 1 ' Electrostatic potential from Total SCF Density') open(22,file='potn.cub') call chead(22,' Potential',nat,x0,i3,v3,xv,qq, 1 ' Electrostatic potential from Total SCF Density') if(nproc.ne.0)call omp_set_num_threads(nproc) inquire(file='SAO.SCR',exist=lex) if(lex)then allocate(s(nao,nao)) open(33,file='SAO.SCR',form='unformatted') do 34 i=1,nao 34 read(33)(s(i,j),j=1,i) do 35 i=1,nao do 35 j=1,i-1 35 s(j,i)=s(i,j) close(33) write(6,607) 607 format(' SAO.SCR read, orbital norms:') do 6 i=1,ndo on=0.0d0 do 51 j=1,nao do 51 k=1,nao 51 on=on+cij(i,j)*s(j,k)*cij(i,k) write(6,608)i,on 608 format(i6,f10.5,$) if(mod(i,5).eq.0)write(6,*) on=1.0d0/dsqrt(on) do 6 j=1,nao 6 cij(i,j)=cij(i,j)*on write(6,*) write(6,*)'Occupied MOs renormalized' endif call mks(nao,d,cij,ndo) call swp(qq,qqt,nat) write(6,800) 800 format(' Atom electronic nuclear total:') C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(ia,fi,x,y,z,orb,fip) do 4 ia=1,nat x=xv(1,ia) y=xv(2,ia) z=xv(3,ia) call sorb(orb,x,y,z,ty,nao,nat,xv,nop,alpha,ish, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13,nlim) call dep(fi,nao,d,orb) call dnp(x,y,z,fip,nat,qqt,xv) 4 write(6,801)ia,fi,fip,fip+fi 801 format(i6,3f12.6) if(lleb)then natl=nat allocate(xll(nleb),yll(nleb),zll(nleb),wll(nleb), 1 xs(nleb*natl),ys(nleb*natl),zs(nleb*natl),ws(nleb*natl), 1 fis(nleb*natl)) call fillllpoints(nleb,nat,natl,nls, 1 xll,yll,zll,wll,rleb,xs,ys,zs,ws,xv) write(6,802) 802 format(' LL point electronic nuclear total:') C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(ia,fi,x,y,z,orb,fip) do 44 ia=1,nls x=xs(ia) y=ys(ia) z=zs(ia) call sorb(orb,x,y,z,ty,nao,nat,xv,nop,alpha,ish, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13,nlim) call dep(fi,nao,d,orb) call dnp(x,y,z,fip,nat,qqt,xv) fis(ia)=fi+fip 44 write(6,801)ia,fi,fip,fip+fi c ESP fitting write(6,805)qt,aes 805 format(' ESP fitting',/, 1 ' Qtot = ',f10.2,', damp = ',e10.4) open(8,file='SURFACE.X',status='old') read(8,*) read(8,*)nr allocate(xr(nr),yr(nr),zr(nr),cr(nr),qr(nr)) do 5 ia=1,nr 5 read(8,*)cr(ia),xr(ia),yr(ia),zr(ia) close(8) write(6,*)nr,' atoms in SURFACE.X' allocate(m(nr+1,nr+1),mi(nr+1,nr+1),v(nr+1)) m=0.0d0 v=0.0d0 do 101 i=1,nls x=xs(i) y=ys(i) z=zs(i) fi=fis(i) do 101 ia=1,nr xa=xr(ia)/bohr ya=yr(ia)/bohr za=zr(ia)/bohr da=dsqrt((x-xa)**2+(y-ya)**2+(z-za)**2) v(ia)=v(ia)+fi/da do 101 ib=1,nr xb=xr(ib)/bohr yb=yr(ib)/bohr zb=zr(ib)/bohr db=dsqrt((x-xb)**2+(y-yb)**2+(z-zb)**2) 101 m(ia,ib)=m(ia,ib)+1.0d0/da/db v(nr+1)=qt do 102 ia=1,nr m(ia,ia)=m(ia,ia)+aes m(ia,nr+1)=1.0d0 102 m(nr+1,ia)=1.0d0 call INV(m,mi,nr+1,1.0d-20) write(6,*)'Inverted' do 103 ia=1,nr qr(ia)=0.0d0 do 103 i=1,nr+1 103 qr(ia)=qr(ia)+mi(ia,i)*v(i) write(6,803) 803 format(' point charge:') open(8,file='FILEF.X') write(8,*)'Surface with ESP charges' write(8,*)nr do 104 ia=1,nr write(8,804)cr(ia),xr(ia),yr(ia),zr(ia),qr(ia) 804 format(i6,3f12.6,' 0 0 0 0 0 0 0 ',f11.5) write(6,8011)ia,qr(ia) 8011 format(i6,f10.5,$) 104 if(mod(ia,5).eq.0)write(6,*) write(6,*) close(8) write(6,806) 806 format(' LL point exact potential fit') rms=0.0d0 do 45 i=1,nls x=xs(i) y=ys(i) z=zs(i) fi=0.0d0 do 46 ia=1,nr xa=xr(ia)/bohr ya=yr(ia)/bohr za=zr(ia)/bohr da=dsqrt((x-xa)**2+(y-ya)**2+(z-za)**2) 46 fi=fi+qr(ia)/da rms=rms+(fis(i)-fi)**2 write(6,8012)i,fis(i),fi 8012 format(i6,2f10.5,$) 45 if(mod(i,3).eq.0)write(6,*) rms=dsqrt(rms/dble(nls)) write(6,807)rms 807 format(' RMS:',e12.4) endif C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(ix,j1,iy,j2,iz,j3,x,y,z,orb,fi,fip) do 3 ix=1,i3(1) j1=dble(ix-1) do 3 iy=1,i3(2) j2=dble(iy-1) do 3 iz=1,i3(3) j3=dble(iz-1) x=x0(1)+j1*v3(1,1)+j2*v3(2,1)+j3*v3(3,1) y=x0(2)+j1*v3(1,2)+j2*v3(2,2)+j3*v3(3,2) z=x0(3)+j1*v3(1,3)+j2*v3(2,3)+j3*v3(3,3) call sorb(orb,x,y,z,ty,nao,nat,xv,nop,alpha,ish, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13,nlim) c nuclear part: call dnp(x,y,z,fip,nat,qqt,xv) rzt(ix,iy,iz)=fip c electronic part: call dep(fi,nao,d,orb) 3 rz(ix,iy,iz)=fi+fip do 31 ix=1,i3(1) do 31 iy=1,i3(2) write(22,1214)(rzt(ix,iy,iz),iz=1,i3(3)) 31 write(42,1214)(rz(ix,iy,iz),iz=1,i3(3)) 1214 format(6E13.5) close(22) close(42) endif return end subroutine swp(qq,qqt,nat) implicit none integer*4 nat,i,qq(nat),qqt(nat) logical lex qqt=qq inquire(file='Q.LST',exist=lex) if(lex)then write(6,*)' atomic charges redefined from Q.LST' open(9,file='Q.LST') read(9,*)(qqt(i),i=1,nat) close(9) endif return end subroutine dep(fi,nao,d,orb) implicit none integer*4 nao,a,b real*8 fi,d(nao,nao),orb(nao,nao) fi=0.0d0 do 1 a=1,nao fi=fi-d(a,a)*orb(a,a) do 1 b=1,a-1 1 fi=fi-d(a,b)*(orb(a,b)+orb(b,a)) return end subroutine dnp(x,y,z,fip,nat,qq,xv) implicit none integer*4 nat,a,qq(nat) real*8 x,y,z,fip,xv(3,nat),di fip=0.0d0 do 4 a=1,nat di=dsqrt((xv(1,a)-x)**2+(xv(2,a)-y)**2+(xv(3,a)-z)**2) 4 if(di.gt.1.0d-4)fip=fip+dble(qq(a))/di return end subroutine rod(cij,n,nao,nat,lopen,qq,xv,ty,nop,ish,n22, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha,ni,nlim, 1ld5,lf7,lg9,lh11,li13,w,dl,eau,aij,ebij,ecij,gnm,nproc) implicit none integer*4 nor parameter (nor=80) integer*4 nao,nat,ii,i3(3),qq(nat),nop(*),nlim, 1ish(nat,nor),ix,iy,iz,a,n,ixx,aij(*),ebij(*),b, 1n22,ni(2*n),nproc real*8 cij(nao,nao),x0(3),v3(3,3),xv(3,nat),x,y,z, 1alpha(nat,nor),ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28),j1,j2,j3,dl(n,3),eau(n),ecij(*),wau, 1gnm,gau,w,roi,ror character*1 ty(nat,nor) real*8,allocatable::rz(:,:,:),orb(:),dr(:,:),di(:,:) logical lopen,ld5,lf7,lg9,lh11,li13 character*1 xyz(3) data xyz/'x','y','z'/ c w ...excitation frequency in nm c gnm ... narrow bandwidth in nm wau=1.0d7/w/219474.0d0 gau=(gnm/w)*wau call rdc(ii,x0,i3,v3) allocate(rz(i3(1),i3(2),i3(3)),orb(nao),dr(nao,nao),di(nao,nao)) if(lopen)then call report('Open shell not implemented') else c loop over light polarizations do 102 ixx=1,3 write(6,*)' Electron dynamic density - '//xyz(ixx) call mkd(ixx,n,nao,n22,ni,dr,di,wau,eau,gau,dl,aij,ebij, 1 ecij,cij,nproc) if(nproc.ne.0)call omp_set_num_threads(nproc) open(12,file='den'//xyz(ixx)//'.cub') call chead(12,' Dynamic Electron density '//xyz(ixx), 1 nat,x0,i3,v3,xv,qq,' Electron density from Total SCF Density') C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(ix,j1,iy,j2,iz,j3,x,y,z,orb,roi,ror,a,b) do 3 ix=1,i3(1) j1=dble(ix-1) do 3 iy=1,i3(2) j2=dble(iy-1) do 3 iz=1,i3(3) j3=dble(iz-1) x=x0(1)+j1*v3(1,1)+j2*v3(2,1)+j3*v3(3,1) y=x0(2)+j1*v3(1,2)+j2*v3(2,2)+j3*v3(3,2) z=x0(3)+j1*v3(1,3)+j2*v3(2,3)+j3*v3(3,3) call forb(orb,x,y,z,ty,nao,nat,xv,nop,alpha,ish,nlim, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13) roi=0.0d0 ror=0.0d0 do 6 a=1,nao do 6 b=1,nao ror=ror+dr(a,b)*orb(a)*orb(b) 6 roi=roi+di(a,b)*orb(a)*orb(b) 3 rz(ix,iy,iz)=2.0d0*(ror**2+roi**2) do 31 ix=1,i3(1) do 31 iy=1,i3(2) 31 write(12,1214)(rz(ix,iy,iz),iz=1,i3(3)) 1214 format(6E13.5) 102 close(12) endif return end subroutine chead(io,s,nat,x0,i3,v3,xv,qq,t) implicit none integer*4 io,nat,i,j,qq(nat),i3(3) real*8 x0(3),v3(3,3),xv(3,nat) character*(*) s,t write(io,1212)(s(i:i),i=1,len(s)) write(io,1212)(t(i:i),i=1,len(t)) 1212 format(80A1) write(io,1213)nat,x0 1213 format(i5,4f12.6) do 1 i=1,3 1 write(io,1213)i3(i),(v3(i,j),j=1,3) do 2 i=1,nat 2 write(io,1213)qq(i),dble(qq(i)),(xv(j,i),j=1,3) return end subroutine roj(cij,n,nao,nat,lopen,qq,xv,ty,nop,ish,n22, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha,ni,nlim, 1ld5,lf7,lg9,lh11,li13,w,dl,eau,aij,ebij,ecij,gnm,nproc) implicit none integer*4 nor parameter (nor=80) integer*4 nao,nat,ii,i3(3),qq(nat),nop(*),nlim, 1ish(nat,nor),ix,iy,iz,n,ixx,aij(*),ebij(*), 1n22,ni(2*n),nproc real*8 cij(nao,nao),x0(3),v3(3,3),xv(3,nat),x,y,z, 1alpha(nat,nor),ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28),j1,j2,j3,dl(n,3),eau(n),ecij(*),wau, 1gnm,gau,w,joi(3),jor(3) character*1 ty(nat,nor) real*8,allocatable::rz(:,:,:),orb(:),dr(:,:),di(:,:),gorb(:,:), 1rzx(:,:,:),rzy(:,:,:),rzz(:,:,:) logical lopen,ld5,lf7,lg9,lh11,li13 character*1 xyz(3) data xyz/'x','y','z'/ c w ...excitation frequency in nm c gnm ... narrow bandwidth in nm wau=1.0d7/w/219474.0d0 gau=(gnm/w)*wau call rdc(ii,x0,i3,v3) allocate(rz(i3(1),i3(2),i3(3)),orb(nao),dr(nao,nao),di(nao,nao), 1gorb(nao,3),rzx(i3(1),i3(2),i3(3)),rzy(i3(1),i3(2),i3(3)), 1rzz(i3(1),i3(2),i3(3))) if(lopen)then call report('Open shell not implemented') else if(nproc.ne.0)call omp_set_num_threads(nproc) c loop over light polarizations do 102 ixx=1,3 write(6,*)' Electron current density - '//xyz(ixx) open(12,file='j'//xyz(ixx)//'.cub') do 1021 ix=1,3 1021 open(12+ix,file='j'//xyz(ix)//'_'//xyz(ixx)//'.cub') do 1022 ix=12,15 1022 call chead(ix,' Dynamic Electron density '//xyz(ixx), 1 nat,x0,i3,v3,xv,qq,' Electron density from Total SCF Density') call mkd(ixx,n,nao,n22,ni,dr,di,wau,eau,gau,dl,aij,ebij, 1 ecij,cij,nproc) c cube header: C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(ix,j1,iy,j2,iz,j3,x,y,z,orb,gorb,jor,joi) do 3 ix=1,i3(1) j1=dble(ix-1) do 3 iy=1,i3(2) j2=dble(iy-1) do 3 iz=1,i3(3) j3=dble(iz-1) x=x0(1)+j1*v3(1,1)+j2*v3(2,1)+j3*v3(3,1) y=x0(2)+j1*v3(1,2)+j2*v3(2,2)+j3*v3(3,2) z=x0(3)+j1*v3(1,3)+j2*v3(2,3)+j3*v3(3,3) call grorb(orb,gorb,x,y,z,ty,nao,nat,xv,nop,alpha,ish,nlim, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13) call sssm(nao,jor,joi,dr,di,orb,gorb) c reaal parts of the current: rzx(ix,iy,iz)=jor(1) rzy(ix,iy,iz)=jor(2) rzz(ix,iy,iz)=jor(3) 3 rz(ix,iy,iz)=2.0d0* 1 (jor(1)**2+joi(1)**2+jor(2)**2+joi(2)**2+jor(3)**2+joi(3)**2) do 31 ix=1,i3(1) do 31 iy=1,i3(2) write(12,1214)(rz( ix,iy,iz),iz=1,i3(3)) write(13,1214)(rzx(ix,iy,iz),iz=1,i3(3)) write(14,1214)(rzy(ix,iy,iz),iz=1,i3(3)) 31 write(15,1214)(rzz(ix,iy,iz),iz=1,i3(3)) 1214 format(6E13.5) do 102 ix=12,15 102 close(ix) endif return end subroutine atat(nat,xv,p0,dv1,dv2,qq,v1,v2) implicit none integer*4 nat,ia,ix,qq(nat) real*8 xvp(3),xv(3,nat),bohr,p0(3),s1,s2,dv1,dv2,v1(3),v2(3) bohr=0.529177d0 dv1=dsqrt(v1(1)**2+v1(2)**2+v1(3)**2) dv2=dsqrt(v2(1)**2+v2(2)**2+v2(3)**2) open(12,file='at.txt') do 7 ia=1,nat do 71 ix=1,3 71 xvp(ix)=xv(ix,ia)*bohr-p0(ix) s1=(xvp(1)*v1(1)+xvp(2)*v1(2)+xvp(3)*v1(3))/dv1 s2=(xvp(1)*v2(1)+xvp(2)*v2(2)+xvp(3)*v2(3))/dv2 7 write(12,1213)ia,qq(ia),s1,s2 1213 format(2i6,2f12.4) close(12) write(6,*)'at.txt' return end subroutine sssm(nao,jor,joi,dr,di,orb,gorb) implicit none integer*4 nao,a,b real*8 joi(3),jor(3),dr(nao,nao),orb(nao),gorb(nao,3),oo, 1di(nao,nao) joi=0.0d0 jor=0.0d0 do 6 a=1,nao do 6 b=1,nao oo=dr(a,b)*orb(a) jor(1)=jor(1)+oo*gorb(b,1) jor(2)=jor(2)+oo*gorb(b,2) jor(3)=jor(3)+oo*gorb(b,3) oo=di(a,b)*orb(a) joi(1)=joi(1)+oo*gorb(b,1) joi(2)=joi(2)+oo*gorb(b,2) 6 joi(3)=joi(3)+oo*gorb(b,3) return end subroutine rop(cij,n,nao,nat,lopen,qq,xv,ty,nop,ish,n22,n1,n2, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha,ni,nlim,v1,v2,p0, 1ld5,lf7,lg9,lh11,li13,w,dl,eau,aij,ebij,ecij,gnm,nproc) implicit none integer*4 nor parameter (nor=80) integer*4 nao,nat,qq(nat),nop(*),nlim,n1,n2,ish(nat,nor),ix,iy, 1n,ixx,aij(*),ebij(*),n22,ni(2*n),nproc real*8 cij(nao,nao),xv(3,nat),x,y,z,alpha(nat,nor),ccs(nat,nor), 1ccp(nat,nor),ccd(nat,nor,2),ccf(nat,nor,3),cci_G(nat,nor,15), 1cci_H(nat,nor,21),cci_I(nat,nor,28),j1,j2,dl(n,3),eau(n),ecij(*), 1wau,gnm,gau,w,joi(3),jor(3),v1(3),v2(3),p0(3),bohr,dv1,dv2, 1ro character*1 ty(nat,nor) real*8,allocatable::orb(:),dr(:,:),di(:,:),gorb(:,:),plane(:,:), 1pl(:,:),rpl(:,:),rplt(:,:) logical lopen,ld5,lf7,lg9,lh11,li13 character*1 xyz(3) data xyz/'x','y','z'/ bohr=0.529177d0 c w ...excitation frequency in nm c gnm ... narrow bandwidth in nm wau=1.0d7/w/219474.0d0 gau=(gnm/w)*wau allocate(orb(nao),dr(nao,nao),di(nao,nao),gorb(nao,3)) c atom coordinates relative to this projection call atat(nat,xv,p0,dv1,dv2,qq,v1,v2) write(6,600)w,wau,gnm,p0,v1,n1,v2,n2 600 format(' Dynamic density and current density in a plane',/,/, 1 ' Frequency (nm/au):',F11.2,' / ',e11.4,/, 1 ' d:',f10.2,' nm ',/, 1 ' origin:',3f10.2,' A',/, 1 ' v1:',3f10.2,' A(',i4,' points)',/, 1 ' v2:',3f10.2,' A(',i4,' points)',/) if(lopen)then call report('Open shell not implemented') else c loop over light polarizations allocate(plane(n1,n2),pl(n1,n2),rpl(n1,n2),rplt(n1,n2)) if(nproc.ne.0)call omp_set_num_threads(nproc) pl=0.0d0 rplt=0.0d0 do 102 ixx=1,3 write(6,*)' Electron current density in plane - '//xyz(ixx) call mkd(ixx,n,nao,n22,ni,dr,di,wau,eau,gau,dl,aij,ebij, 1 ecij,cij,nproc) C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(ix,j1,iy,j2,x,y,z,orb,gorb,jor,joi,ro) do 3 ix=1,n1 write(6,605)ix 605 format(i5,$) j1=dble(ix-1) do 3 iy=1,n2 j2=dble(iy-1) x=(p0(1)+j1*v1(1)+j2*v2(1))/bohr y=(p0(2)+j1*v1(2)+j2*v2(2))/bohr z=(p0(3)+j1*v1(3)+j2*v2(3))/bohr call grorb(orb,gorb,x,y,z,ty,nao,nat,xv,nop,alpha,ish,nlim, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13) call sssm(nao,jor,joi,dr,di,orb,gorb) call ss1(ro,nao,dr,di,orb) rpl(ix,iy)=ro rplt(ix,iy)=rplt(ix,iy)+ro plane(ix,iy)=2.0d0* 1 (jor(1)**2+joi(1)**2+jor(2)**2+joi(2)**2+jor(3)**2+joi(3)**2) 3 pl(ix,iy)=pl(ix,iy)+plane(ix,iy) call wrpl('ro'//xyz(ixx)//'.txt',n1,n2,dv1,dv2,rpl) write(6,*)'ro'//xyz(ixx)//'.txt' call wrpl('j'//xyz(ixx)//'.txt',n1,n2,dv1,dv2,plane) 102 write(6,*)'j'//xyz(ixx)//'.txt' c ixx call wrpl('rot.txt',n1,n2,dv1,dv2,rplt) write(6,*)'rot.txt' call wrpl('jt.txt',n1,n2,dv1,dv2,pl) write(6,*)'jt.txt' endif return end subroutine ss1(ro2,nao,dr,di,orb) implicit none integer*4 nao,a,b real*8 ro2,dr(nao,nao),di(nao,nao),orb(nao),roi,ror roi=0.0d0 ror=0.0d0 do 6 a=1,nao ror=ror+dr(a,a)*orb(a)*orb(a) roi=roi+di(a,a)*orb(a)*orb(a) do 6 b=a+1,nao ror=ror+(dr(a,b)+dr(b,a))*orb(a)*orb(b) 6 roi=roi+(di(a,b)+dr(b,a))*orb(a)*orb(b) ro2=ror*ror+roi*roi return end subroutine ro2(cij,nao,nat,lopen,qq,xv,ty,nop,ish,ndo,nlim, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha, 1ld5,lf7,lg9,lh11,li13,nproc) implicit none integer*4 nor parameter (nor=80) integer*4 nao,nat,i,ii,i3(3),qq(nat),nop(*),nlim, 1ish(nat,nor),ix,iy,iz,ndo,a,nproc real*8 cij(nao,nao),x0(3),v3(3,3),xv(3,nat),rox,x,y,z, 1alpha(nat,nor),ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28),psi,j1,j2,j3 character*1 ty(nat,nor) real*8,allocatable::rz(:,:,:),orb(:) logical lopen,ld5,lf7,lg9,lh11,li13 write(6,*)' Electron density' call rdc(ii,x0,i3,v3) allocate(rz(i3(1),i3(2),i3(3)),orb(nao)) if(nproc.ne.0)call omp_set_num_threads(nproc) if(lopen)then call report('Open shell not implemented') else open(12,file='den2.cub') call chead(12,' Electron density ',nat,x0,i3,v3,xv,qq, 1 ' Electron density from Total SCF Density') C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(ix,j1,iy,j2,iz,j3,x,y,z,orb,rox,i,psi,a) do 3 ix=1,i3(1) j1=dble(ix-1) do 3 iy=1,i3(2) j2=dble(iy-1) do 3 iz=1,i3(3) j3=dble(iz-1) x=x0(1)+j1*v3(1,1)+j2*v3(2,1)+j3*v3(3,1) y=x0(2)+j1*v3(1,2)+j2*v3(2,2)+j3*v3(3,2) z=x0(3)+j1*v3(1,3)+j2*v3(2,3)+j3*v3(3,3) call forb(orb,x,y,z,ty,nao,nat,xv,nop,alpha,ish,nlim, 1 ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13) rox=0.0d0 do 5 i=1,ndo psi=0.0d0 do 6 a=1,nao 6 psi=psi+cij(i,a)*orb(a) 5 rox=rox+psi**2 3 rz(ix,iy,iz)=2.0d0*rox do 31 ix=1,i3(1) do 31 iy=1,i3(2) 31 write(12,1214)(rz(ix,iy,iz),iz=1,i3(3)) 1214 format(6E13.5) close(12) endif return end subroutine rdc(ii,x0,i3,v3) c read cube parameters c x0 - origin c i3 - number of grid points c v3 - grid vectors implicit none integer*4 ii,i3(3),i,j real*8 x0(3),v3(3,3),bohr bohr=0.529177d0 open(12,file='CAGE.PAR',status='old') read(12,*)ii,x0 do 1 i=1,3 1 read(12,*)i3(i),v3(i,1),v3(i,2),v3(i,3) x0(1)=x0(1)/bohr x0(2)=x0(2)/bohr x0(3)=x0(3)/bohr do 2 i=1,3 do 2 j=1,3 2 v3(i,j)=v3(i,j)/bohr close(12) return end subroutine readopt(ifn,lturbo,nao,nmo,ld5,lf7,lg9,lh11,li13, 1lzmat,ifix,lnorm,lort,lwrt,lden,lbck,gammaau,gammanm,lgau,lgnm, 1wmin,wmax,np,w,gnm,lro,lt,le,lb,v1,v2,p0,n1,n2,nproc,nlim,lout, 1llog,lcis,mo1,mo2,ncis,dcis,xcis,wcis,lleb,nleb,rleb,nmol,lat, 1lfi,qt,aes,lj,ljp,nnm,nw0,loniom,io1,io2,lpol) implicit none integer*4 nao,nmo,ifix,np,nleb,n1,n2,nproc,nlim,mo1,mo2,nmol, 1nnm,nw0,ii,io1,io2 real*8 gammaau,gammanm,wmin,wmax,gnm,w(nw0),v1(3),v2(3),p0(3), 1dcis,xcis,ncis,wcis,rleb,qt,aes character*80 ifn character*4 key,keyo logical lturbo,ld5,lf7,lzmat,lnorm,lort,lwrt,lden,lbck,lgau,lgnm, 1lg9,lh11,li13,lex,lro,lt,le,lb,lleb,lout,llog,lcis,lat,lfi,lj, 1ljp,loniom,lpol nnm=1 loniom=.false. lpol=.false. io1=0 io2=0 lj=.false. ljp=.false. aes=0.0d0 qt=0.0d0 lat=.true. lcis=.false. lfi=.false. ncis=0.0d0 xcis=600.0d0 wcis=0.0d0 dcis=300.0d0 nmol=0 mo1=0 mo2=0 llog=.false. nproc=0 nlim=0 n1=0 n2=0 v1=0.0d0 v2=0.0d0 p0=0.0d0 np=10 wmin=150.0d0 wmax=500.0d0 lden=.true. lro=.false. lt=.false. le=.false. lb=.false. ld5=.false. lf7=.false. lg9=.false. lh11=.false. li13=.false. lout=.false. lf7=.false. lnorm=.false. lwrt=.false. lort=.false. lbck=.false. lgau=.false. lden=.true. lgnm=.true. lleb=.false. rleb=5.0d0 nleb=62 gammaau=0.02d0 gammanm=10.0d0 nao=0 ifix=0 nmo=0 ifn='G.OUT' lturbo=.false. lzmat=.true. w=532.0d0 gnm=0.1d0 inquire(file='MCUB.OPT',exist=lex) if(lex)then open(7,file='MCUB.OPT') 1 read(7,700,end=99,err=99)key 700 format(a4) keyo=key c npoint (np/10) number of points for polarizability c wmin,wmax (150/500 nm) limits c ld5,lf7,lg9,lh11,li13 (f/f/f/f/f) use spherical AOs c lzmat (t) Z-matrix orientation c lat calculate intensity on atoms c loniom ONIOM output, specify io1 io2 ... interval of H atoms c lpol polarizability from POL.TTT ... not yet c density (lro/f) density cube c dynamic (lt/f) dynamic density cube c current (lj/f) dynamic current density c pcurrent (ljp/f) dynamic current density in plane c field (le/f) electric field cube c lcis (lcis/f) primitive CIS estimation of excitations c ncis (ncis/0) if ncis<>0,transform freqs and dipoles c dcis (dcis/300) if ncis<>0,transform freqs and dipoles c xcis (xcis/0) if ncis<>0,transform freqs and dipoles c wcis (wcis/0 nm) if <>0 limit exc frequency for lcis c mo1,mo2 (mo1/0,mo2/0) range of orbital involved in CIS c nmol if<>0 enhancement at molecular centers c nnm (nnm/1) number of excitation frequencies c nproc (0) number of processors c nlim (0) limit of involved atoms for plane c plane (lb/f) plot electric field plane section c P0x P0y P0z plane origin / A c N1 v1x v1y v1z number of repeats, first plane vector c N2 v2x v2y v2z number of repeats, second plane vector c lout (f) plane electric field only outside molecule c wnm(w/532 nm) excitation frequency, or more if nnm>0 c (in this case nnm should preceed wnm definition) c gnm (0.1 nm) bandwidth to avoid divergence c llog (f) logarithmic scale c filename (G.OUT) ab initio (Gaussian) output file name c Recommended Gaussian options: c GFInput Pop=full iop(9/40=3) or iop(9/40=4) nosymm td if(key.eq.'npoi')read(7,*)np if(key.eq.'nmol')read(7,*)nmol if(key.eq.'onio')read(7,*)loniom,io1,io2 if(key.eq.'lpol')read(7,*)lpol if(key.eq.'wmin')read(7,*)wmin if(key.eq.'wmax')read(7,*)wmax if(key(1:3).eq.'ld5')read(7,*)ld5 if(key(1:3).eq.'lf7')read(7,*)lf7 if(key(1:3).eq.'lg9')read(7,*)lg9 if(key(1:3).eq.'lat')read(7,*)lat if(key.eq.'lh11')read(7,*)lh11 if(key.eq.'li13')read(7,*)li13 if(key.eq.'lcis')read(7,*)lcis if(key.eq.'ncis')read(7,*)ncis if(key.eq.'xcis')read(7,*)xcis if(key.eq.'dcis')read(7,*)dcis if(key.eq.'wcis')read(7,*)wcis if(key(1:3).eq.'mo1')read(7,*)mo1 if(key(1:3).eq.'mo2')read(7,*)mo2 if(key.eq.'lzma')read(7,*)lzmat if(key.eq.'dens')read(7,*)lro if(key.eq.'curr')read(7,*)lj if(key.eq.'pcur')read(7,*)ljp if(key.eq.'dyna')read(7,*)lt if(key.eq.'fiel')read(7,*)le if(key.eq.'npro')read(7,*)nproc if(key.eq.'nlim')read(7,*)nlim c static potential: if(key.eq.'pote')read(7,*)lfi if(key.eq.'lout')read(7,*)lout c lleb ... Lebedev-Laikov spheres of inner atoms to integrate surface c rleb ... sphere radius c nleb ... number of points if(key.eq.'lleb')read(7,*)lleb if(key.eq.'nleb')read(7,*)nleb if(key.eq.'rleb')read(7,*)rleb if(key.eq.'llog')read(7,*)llog if(key.eq.'qtot')read(7,*)qt if(key.eq.'damp')read(7,*)aes if(key.eq.'plan')then read(7,*)lb read(7,*)p0(1),p0(2),p0(3) read(7,*)n1,v1(1),v1(2),v1(3) read(7,*)n2,v2(1),v2(2),v2(3) endif if(key(1:3).eq.'nnm')read(7,*)nnm if(nnm.gt.nw0)call report('Too many frequencies') if(key(1:3).eq.'wnm')read(7,*)(w(ii),ii=1,nnm) if(key(1:3).eq.'gnm')read(7,*)gnm if(key.eq.'file')read(7,80)ifn 80 format(a80) backspace 7 read(7,700,end=99,err=99)key if(key.eq.keyo)then write(6,*)key call report('Unknown option') endif goto 1 99 close(7) endif return end SUBROUTINE ai(nao,nmo,nat,cij,bij,e,be,nop,ty,ish,z,xv, 1alpha,cc,nsa,nsb,ndo,nori,rcp,rcd,at,ld5,lf7,lg9,lh11,li13, 1lturbo,ifn,lzmat,am,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,qq, 1loniom,io1,io2,natt) IMPLICIT REAL*8 (A-H,O-Z) implicit integer*4 (i-n) parameter (nor=80) character*3,allocatable:: aot(:) character*2 at(*) character*(*) ifn real*8 z(*),xv(3,nat),rcp(nat,nor),alpha(nat,nor),am(nat), 1ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2),rcd(nat,nor), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28) integer*4 nop(*),ish(nat,nor),qq(*),io1,io2 character*1 ty(nat,nor) real*8 cij(nao,nao),bij(nao,nao),e(*),be(*),cc(nat,nor) common/rundiff/idif,igeo,ibasis,ieigen integer*4,allocatable::iat(:),isha(:) logical lturbo,ld5,lf7,lzmat,lg9,lh11,li13,loniom allocate(aot(nao),iat(nao),isha(nao)) idif=0 do 1 i=1,nat do 1 j=1,nor 1 ish(i,j)=32000 c c read in basic geometry, basis set, and wavefunction NDIFF=0 ieigen=0 igeo=0 ibasis=0 call roainp(NDIFF,nat,nao,nmo,cc,alpha,rcp,nop,ty,ish,at, 1cij,bij,e,be,z,zsum,xv,am,ichm,mtp,nori, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,noe,ld5,lf7,lg9,lh11,li13, 1lturbo,ifn, 1lzmat,ndo,nsa,nsb,rcd,qq,loniom,io1,io2,natt) c c control output call writecon(NDIFF,ichm,nat,nao,ndo,nmo,noe,nsa,nsb,zsum, 1ish,alpha,nop,ty,cc,rcp,rcd,e,be,z,xv,at,aot,iat,isha, 1ld5,lf7,lg9,lh11,li13) c call normorb(nat,nao,ccs,ccp,ccd,ccf,cci_G,cci_H, 1cci_I,ty,xv,nop,alpha,ish, 1ld5,lf7,lg9,lh11,li13) write(6,*)'AOs have been renormalized' return end subroutine getdimensions(nat,nao,nmo,lturbo,ifn,loniom,io1,io2, 1natt) implicit none integer*4 nat,nao,naot,nmo,i,io1,io2,ln,natt logical lturbo,loniom character*1 ok character*2 s2 character*4 statesym real*8 er character*80 ifn,k nat=0 c TURBOMOLE if(lturbo)then open(4,file='coord',status='old') 1 read(4,4010)ok 4010 format(a1) if(ok.ne.'$')goto 1 33 read(4,4010)ok if(ok.eq.'$')goto 401 backspace 4 nat=nat+1 read(4,*) goto 33 401 close(4) write(6,*)nat,' atoms' c open(4,file='mos',status='old') naot=0 statesym='1234' 2 read(4,4009)k 4009 format(a80) if(k(16:25).ne.'eigenvalue')goto 2 nmo=0 3 nmo=nmo+1 if(k(7:9).ne.statesym)naot=naot+nao statesym=k(7:9) read(k,4002)er,nao 4002 format(26x,d20.14,9x,i3) read(4,4003)(er,i=1,nao) 4003 format(4d20.14) read(4,4009)k if(k(1:4).ne.'$end') goto 3 close(4) nao=nao+naot goto 99 endif c c Browse at the G output: open(2,file=ifn) ln=0 4 read(2,1001,end=99,err=99)k ln=ln+1 1001 format(a80) C if(k(20:35).eq.'Standard orienta'.or. 1 k(26:41).eq.'Standard orienta'. or. 1 k(19:35).eq.'Z-Matrix orientat'. or. 1 k(26:42).eq.'Z-Matrix orientat'. or. 1 k(27:43).eq.'Input orientation'. or. 1 k(20:36).eq.'Input orientation')then do 1031 i=1,4 ln=ln+1 1031 read(2,*) i=0 1011 i=i+1 read(2,3335)s2 ln=ln+1 3335 format(a2) if(s2.ne.' -')then backspace 2 read(2,*) goto 1011 endif nat=i-1 endif if(k(8:22).eq.'basis functions')read(k(1:6),*)nao if(k(2:8).eq.'NBasis=')read(k(9:14),*)nao if(k(2:8).eq.'NBsUse=')read(k(9:14),*)nmo c GAUSSIAN FORMATTED CHECKPOINT: if(k(1:15).eq.'Number of atoms')read(k(50:61),*)nat if(k(1:25).eq.'Number of basis functions')read(k(50:61),*)nao if(nat.eq.0.or.nao.eq.0.or.nmo.eq.0)goto 4 c 99 close(2) if(nmo.eq.0)nmo=nao write(6,600)ln,nat,nao,nmo 600 format(i5,' lines read,',i5,' atoms,',/, 1 i5,' AOs,',i5,' MOs',/) if(nat.eq.0)call report('No atoms!') if(nao.eq.0)call report('No orbitals!') natt=nat if(loniom)then nat=io2-io1+1 write(6,601)nat 601 format(' ONIOM: number of high level atoms:',i5,/) endif return end subroutine init implicit real*8 (a-h,o-z) implicit integer*4 (i-n) common/const/pi,spt,bohr common/numbers/z0,one,two,three,four,five,half,a10 pi=dble(4)*datan(dble(1)) spt=sqrt(dble(2)/pi) bohr=0.52917705993d0 c z0=dble(0) one=dble(1) two=dble(2) three=dble(3) four=dble(4) five=dble(5) half=one/two a10=dble(10) return end subroutine roainp(ndiff,nat,nao,nmo,cc,alpha,rcp,nop,ty,ish,at, 1cij,bij,e,be,z,zsum,xv,am,ichm,mtp,nori, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,noe,ld5,lf7,lg9,lh11,li13, 1lturbo,ifn, 1lzmat,ndo,nsa,nsb,rcd,qq,loniom,io1,io2,natt) c implicit real*8 (a-h,o-z) implicit integer*4 (i-n) c parameter (nor=80,MENDELEV=89) character*2 at(*),s2,symbols(MENDELEV) character*1 ty(nat,nor) character*(*) ifn common/const/pi,spt,bohr real*8 cc(nat,nor),alpha(nat,nor),rcp(nat,nor),rcd(nat,nor), 1cij(nao,nao),bij(nao,nao),e(*),be(*), 1z(*),zsum,xv(3,nat) integer*4 nop(*),ish(nat,nor),qq(*),io1,io2 real*8 ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28) common/spdfgh/nxig(15),nyig(15),nzig(15), 2nxih(21),nyih(21),nzih(21),nxii(28),nyii(28),nzii(28) common/rundiff/idif,igeo,ibasis,ieigen logical ld5,lf7,loniom, 1ld2,lzmat,XYZ,ABINI,CC5,LAN,LDO,lsp, 9lopt,lconfig,lturbo,lbasred,lg9,lh11,li13, 1lgeo,lopen,lbasis,lnoe,lcij common/opts/lopt(300),icha equivalence 1(lopt(9),ld2 ), 1(lopt(13),XYZ ),(lopt(14),ABINI ),(lopt(15),cc5 ), 1(lopt(16),lan ),(lopt(17),ldo ), 1(lopt(19),lsp ), 1(lopt(65),lconfig), 1(lopt(92),lbasred ) common/iopts/iopt(300) equivalence (iopt(1),ncnmr),(iopt(2),inormo ),(iopt(3),nek1 ), 1 (iopt(4),nek2 ),(iopt(5),nej1 ),(iopt(6),nej2 ), 1 (iopt(7),ioe ),(iopt(8),nstart ),(iopt(9),nend ), 1 (iopt(10),nprc),(iopt(11),multi ),(iopt(12),ndog ), 1 (iopt(13),nsi ),(iopt(14),nconfig),(iopt(15),nproc ), 1 (iopt(16),neci),(iopt(17),idiago ),(iopt(18),igradc), 1 (iopt(19),nev ),(iopt(20),mmit ),(iopt(21),iham ), 1 (iopt(22),ncut),(iopt(23),nk ),(iopt(24),nj ) character*80 key integer*4,allocatable:: ipse(:) data symbols/'H ','He','Li','Be','B ','C ','N ','O ','F ','Ne', 3'Na','Mg','Al','Si','P ','S ','Cl','Ar', 4'K ','Ca','Sc','Ti','V ','Cr','Mn','Fe','Co','Ni','Cu','Zn', 4 'Ga','Ge','As','Se','Br','Kr', 5'Rb','Sr','Y ','Zr','Nb','Mo','Tc','Ru','Rh','Pd','Ag','Cd', 5 'In','Sn','Sb','Te','I ','Xe', 6'Cs','Ba','La', 6 'Ce','Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy','Ho', 6 'Er','Tm','Yb','Lu', 6'Hf','Ta','W ','Re','Os','Ir','Pt','Au','Hg', 6 'Tl','Pb','Bi','Po','At','Rn', 7'Fr','Ra','Ac'/ real*8 am(*) dimension amas(MENDELEV) data amas/1.008,4.003, 2 6.941, 9.012, 10.810,12.011,14.007,15.999,18.998,20.179, 3 22.990,24.305, 26.981,28.086,30.974,32.060,35.453,39.948, 4 39.098,40.080,44.956,47.900,50.941,51.996,54.938,55.847, 4 58.933,58.700,63.546,65.380, 4 69.720,72.590,74.922,78.960,79.904,83.800, 5 85.468,87.620,88.906,91.220,92.906,95.940,98.906,101.070, 5 102.906,106.400,107.868,112.410, 5 114.82,118.69,121.75,127.600,126.905,131.300, 6 132.905,137.330,138.906, 6 140.120,140.908,144.240,145.000,150.400, 6 151.960,157.250,158.925,162.500,164.930,167.260,168.934, 6 173.040,174.970, 6 178.490,180.948,183.850,186.207,190.200,192.220,195.090, 6 196.967,207.590,204.370,207.200,208.980,210.000,210.001, 6 222.02, 7 223.000,226.025,227.028/ c gaussian checkpoint: c shell types,number of primitives per shell,shell to atom map, c npe/rpe-primitive exponents c ncc/rcc-contraction coefficients c ncl/rcl-contraction coefficients P in SP integer*4 ,allocatable::ist(:),ipps(:),istam(:) integer*4 nst,npps,nstam,npe,ncc,ncl real*8,allocatable::rpe(:),rcc(:),rcl(:) allocate(ipse(natt),ist(nao),ipps(nao), 1istam(nao),rpe(nao),rcc(nao),rcl(nao)) c write(6,*)'roainp' nst=0 npps=0 nstam=0 npe=0 ncc=0 c Thinks to be read now: lgeo=.false. lopen=.false. lbasis=.false. lnoe=.false. lcij=.false. if(lturbo)then call readtm(nat,nao,ccs,ccp,ccd,ccf, 1 xv,e,be,cij,bij,at,alpha,cc,ish,ichm,mtp,nsa,nsb, 1 nop,z,noe, 1 ld5,lf7) return endif c c GAUSSIAN 94 OUTPUT CATCHING: open(2,file=ifn) ic=0 111 ic=ic+1 read(2,1001,end=666)key 1001 format(a80) c EIGENVALUES (PRINTED WITH THE OPTION IOP(6/7=1)) if(key(1:35).eq.' Molecular Orbital Coefficients'.or. 1 key(1:35).eq.' Alpha Molecular Orbital Coeffi'.or. 1 key(2:11).eq.'Alpha MOs:') then write(6,1001)key lcij=.true. ieigen=ieigen+1 c eigenvectors listed either as a result of IOP(6/7=1) or IOP(5/33=1) nori=nmo call readorb(key,nori,e,cij,nao,nao) do 377 i1=1,nmo be(i1)=e(i1) do 377 i2=1,nao 377 bij(i1,i2)=cij(i1,i2) read(2,1001)key if(key(2:10).eq.'Beta MOs:'.or. 1 key(6:41).eq.'Beta Molecular Orbital Coefficients:')then write(6,1001)key call readorb(key,nori,be,bij,nao,nao) endif endif c if(key(2:10).eq.' SCF done:')write(6,*)key c c GEOMETRY if(key(20:35).eq.'Standard orienta'.or. 1 key(26:41).eq.'Standard orienta')then ig98=0 if(key(26:41).eq.'Standard orienta')ig98=1 write(6,1001)key if(lzmat)then write(6,*)'geometry skipped because lzmat is defined' goto 877 endif goto 776 endif if(key(19:35).eq.'Z-Matrix orientat'.or. 1 key(26:42).eq.'Z-Matrix orientat'.or. 1 key(27:43).eq.'Input orientation'.or. 1 key(20:36).eq.'Input orientation')then ig98=0 if(key(26:42).eq.'Z-Matrix orientat')ig98=1 if(key(27:43).eq.'Input orientation')ig98=1 write(6,1001)key if(.not.lzmat)then write(6,*)'geometry skipped because lzmat is not defined' goto 877 endif goto 776 endif goto 877 776 igeo=igeo+1 do 1031 i=1,4 1031 read(2,*) i=0 j=0 1011 i=i+1 read(2,3335)s2 3335 format(a2) if(s2.ne.' -')then backspace 2 if(loniom)then if(i.ge.io1)j=j+1 if(i.gt.io2)goto 1012 else j=i endif if(ig98.eq.0)read(2,*)iza,iza, xv(1,j),xv(2,j),xv(3,j) if(ig98.eq.1)read(2,*)iza,iza,itype,xv(1,j),xv(2,j),xv(3,j) qq(j)=iza z(j)=dble(iza) am(j)=amas(iza) at(j)=symbols(iza) if(itype.eq.1000)then z(j)=0.0d0 at(j)='Bq' endif goto 1011 endif 1012 nat=i-1 write(6,*)'nat = ',nat zsum=0.0d0 do 1013 i=1,nat zsum=zsum+z(i) do 1013 j=1,3 1013 xv(j,i)=xv(j,i)/bohr write(6,*)'G94 geometry read in,',nat,' atoms' lgeo=.true. noe=nint(zsum)-icha lnoe=.true. if(lconfig)then write(6,*)' Open shell ' write(6,*)' Open shell ',multi,noe ndo=0 nsa=(multi+noe-1)/2 nsb=noe-nsa else write(6,*)' Closed shell ' ndo=noe/2 nsa=0 nsb=0 endif ndog=ndo nsi=nsa-nsb ichm=icha mtp=1 877 continue c c Electron configuration if( key(8:22).eq.'alpha electrons')then read(key( 1: 6),*)nsa read(key(24:31),*)nsb noe=nsa+nsb multi=nsa-nsb+1 lopen=.true. write(6,*)' Electron numbers read' write(6,3434)noe,nsa,nsb,multi 3434 format(' noe:',i5,' nsa:',i5,' nsb:',i5,' M:',i2) if(nsa.eq.nsb)then write(6,*)' Closed shell' c In the sos formalism, sinly occupied orbitals are none: nsa=0 nsb=0 ndo=noe/2 else write(6,*)' Open shell' ndo=0 endif endif c c BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB c BASIS GFInput if( key(2:46).eq.'Basis set in the form of general basis input:' 1.or.key(2:46).eq.'AO basis set in the form of general basis inp' 2 )then write(6,*)key write(6,6000)ld5,lf7,lg9,lh11,li13 write(6,6000)ld5,lf7,lg9,lh11,li13 6000 format(' LD5 LF7 LG9 LH11 LI13: ',5L2) ibasis=ibasis+1 call getbasis(nao,nat,nop,nor,ish,ld5,lf7,lg9,lh11,li13, 1 ty,cc,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha, 1 nxig,nyig,nzig,nxih,nyih,nzih,nxii,nyii,nzii,rcp,rcd) lbasis=.true. if(lbasred)then write(6,*)'Basis check only' return endif endif c BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB if( key(40:50).eq.'Pseudopoten')then write(6,*)key(40:50),natt call rdps(natt,ipse) j=0 do 1 i=1,natt if(ipse(i).ne.0)then if(.not.loniom.or.(i.ge.io1.and.i.le.io2))then j=j+1 write(6,6005)i,ipse(i) 6005 format(' atom ',i6,' atomic charge reduced to',i4) zsum=zsum-z(j)+dble(ipse(i)) z(j)=dble(ipse(i)) endif endif 1 continue noe=nint(zsum)-icha if(lconfig)then write(6,*)' Open shell ' write(6,*)' Open shell ',multi,noe ndo=0 nsa=(multi+noe-1)/2 nsb=noe-nsa else write(6,*)' Closed shell ' ndo=noe/2 nsa=0 nsb=0 endif ndog=ndo nsi=nsa-nsb ichm=icha mtp=1 endif c c BASIS GFPrint c if you want to use this, uncomment next and comment following line: c if(ibasis.eq.0)THEN if(1.eq.0)THEN if((key(2:16).eq.'Standard basis:'.or.key(6:14).eq.'Exponent='. 1 or.key(2:14).eq.'General basis').and.ndiff.eq.0)then if(key(6:14).eq.'Exponent=')then 2222 read(2,1001)key if(key(2:10).ne.'*********')goto 2222 backspace 2 else write(6,*)key endif c c check whether general basis follows read(2,1001)key if( key(2:46).eq.'Basis set in the form of general basis input:' 1.or.key(2:46).eq.'AO basis set in the form of general basis inp') 2 then backspace 2 goto 111 endif c ibasis=ibasis+1 read(2,3336)s2 3336 format(1x,a2) c if(s2.eq.'**')then do 4 i=1,5 4 read(2,*) nao=0 c naolast=0 do 7 i=1,nat nop(i)=0 do 6 k=1,nor 6 ish(i,k)=32000 ishell=0 read(2,*) 3906 read(2,3901,err=7,iostat=ioss)nao,sf 3901 format(47x,I3,10x,F9.2) if(ioss.ne.0)goto 7 if(lopt(298))write(6,3901)nao,sf ishell=ishell+1 ndao=nao-naolast naolast=nao 3904 nop(i)=nop(i)+1 k=nop(i) if(k.gt.nor)call report('Too many primitives on one atom') read(2,3336)s2 if(s2.eq.'**'.or.s2.eq.'*-')goto 3903 backspace 2 read(2,3902,err=3903,iostat=ioss)af,ccs(i,k),ccp(i,k),cc(i,k) 1 ,dum 3902 format(71x,5g12.6) if(abs(af).lt.0.000001d0)goto 3903 if(ioss.ne.0)goto 3903 if(lopt(298))write(6,3902)af,ccs(i,k),ccp(i,k),cc(i,k),dum af=af*sf**2 alpha(i,k)=af ish(i,k)=ishell c c SNO normalization factor to S: a=dble(2)*af/pi SNO=sqrt(sqrt(a*a*a)) c c SNP normalization factor for P: a=af a=dble(128)*a*a*a*a*a/(pi*pi*pi) SNP=sqrt(sqrt(a)) c c SND,SNDD normalization factors for D: a=af a=dble(2048)*a*a*a*a*a*a*a/(pi*pi*pi) SND=sqrt(sqrt(a)) SNDD=SND/sqrt(dble(3)) c c SNFx normalization factors for F(fxxx,fxxy,fxyz): a=dble(2)*af a=sqrt( dble(8)*sqrt(a*a*a*a*a*a*a*a*a)/sqrt(pi*pi*pi) ) SNF1=a/sqrt(dble(15)) SNF2=a/sqrt(dble(3)) SNF3=a c ccd(i,k,1)=cc(i,k)*SNDD ccd(i,k,2)=cc(i,k)*SND c ccf(i,k,1)=dum*SNF1 ccf(i,k,2)=dum*SNF2 ccf(i,k,3)=dum*SNF3 c c store exp coef. for control listing: cc(i,k)=ccs(i,k) rcp(i,k)=ccp(i,k) c ccs(i,k)=ccs(i,k)*SNO ccp(i,k)=ccp(i,k)*SNP if(ndao.eq.1)ty(i,k)='S' if(ndao.eq.3)ty(i,k)='P' if(ndao.eq.4)ty(i,k)='L' if(ndao.eq.5)ty(i,k)='D' if(ndao.eq.5)ld5=.true. if(ndao.eq.6)ty(i,k)='D' if(ndao.eq.7)ty(i,k)='F' if(ndao.eq.7)lf7=.true. if(ndao.eq.10)ty(i,k)='F' if(ndao.eq.9)ty(i,k)='G' if(ndao.eq.9)lg9=.true. if(ndao.eq.15)ty(i,k)='G' if(ndao.eq.11)ty(i,k)='H' if(ndao.eq.11)lh11=.true. if(ndao.eq.21)ty(i,k)='H' if(ndao.eq.13)ty(i,k)='I' if(ndao.eq.13)li13=.true. if(ndao.eq.28)ty(i,k)='I' if(ty(i,k).eq.'D')cc(i,k)=ccd(i,k,1)/SNDD if(ty(i,k).eq.'P')cc(i,k)=ccp(i,k)/SNP if(ty(i,k).eq.'F')cc(i,k)=dum if(ty(i,k).eq.'G')cc(i,k)=dum if(ty(i,k).eq.'H')cc(i,k)=dum if(ty(i,k).eq.'I')cc(i,k)=dum goto 3904 3903 nop(i)=nop(i)-1 backspace 2 read(2,3336)s2 if(s2.eq.'*-'.or.s2.eq.'**')goto 7 backspace 2 goto 3906 7 continue write(6,*) 'G94 standard basis loaded from output' write(6,*) nao,' AOs' c c else c call report('set the iop(5/33=1) for the calculation !') call report('set the GFPRINT option for the calculation !') c endif c endif c endif c (end of Gaussian output catching) c for text outputs, ensure that read only once: if(lgeo.and.lopen.and.lbasis.and.lnoe.and.lcij)goto 666 c c GAUSSIAN FORMATTED CHECKPOINT: c FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF if(key(1:22).eq.'Alpha Orbital Energies')then write(6,1001)key write(6,*)nao,nmo read(2,2009)(e(i1),i1=1,nmo) do 10 i1=1,nmo 10 be(i1)=e(i1) endif if(key(1:21).eq.'Alpha MO coefficients')then write(6,1001)key write(6,*)nao,nmo ieigen=ieigen+1 if(nao.eq.0)nao=nmo read(2,2009)((cij(i1,i2),i2=1,nao),i1=1,nmo) 2009 format(5E16.8) write(6,*) 'Eigenvectors read in from verbose checkpoint... ' do 10041 i=1,nmo do 10041 j=1,nao 10041 bij(i,j)=cij(i,j) endif if(key(1:20).eq.'Beta MO coefficients')then write(6,1001)key read(2,2009)((bij(i1,i2),i2=1,nao),i1=1,nmo) endif if(key(1:21).eq.'Beta Orbital Energies')then write(6,1001)key write(6,*)nao,nmo read(2,2009)(be(i1),i1=1,nmo) endif c GEOMETRY if(key(1:15).eq.'Nuclear charges')then read(2,2009)(z(i),i=1,nat) zsum=0.0d0 do 9 i=1,nat zsum=zsum+z(i) 9 at(i)=symbols(int(z(i))) endif if(key(1:17).eq.'Current cartesian')then write(6,1001)key igeo=igeo+1 c in bohrs read(2,2009)((xv(ix,i),ix=1,3),i=1,nat) endif if(key(1:6).eq.'Charge')then read(key(50:61),*)icha ichm=icha endif if(key(1:19).eq.'Number of electrons')read(key(50:61),*)noe if(key(1:25).eq.'Number of alpha electrons')read(key(50:61),*)nsa if(key(1:24).eq.'Number of beta electrons')then read(key(50:61),*)nsb if(nsa.eq.nsb)then lconfig=.false. ndo=nsa nsa=0 nsb=0 write(6,*)' Closed shell ' else write(6,*)' Open shell ',nsa,nsb ndo=0 endif ndog=ndo nsi=nsa-nsb mtp=1 endif if(key(1:25).eq.'Number of basis functions')read(key(50:61),*)nao c if(key(1:20).eq.'Number of contracted')then c nshells endif if(key(1:11).eq.'Shell types')then read(key(50:61),*)nst write(6,1001)key if(nst.gt.nao)call report('too many shell types') read(2,2003)(ist(i),i=1,nst) 2003 format(6i12) endif if(key(1:30).eq.'Number of primitives per shell')then read(key(50:61),*)npps write(6,1001)key if(npps.gt.nao)call report('too many primitives per shell') read(2,2003)(ipps(i),i=1,npps) endif if(key(1:17).eq.'Shell to atom map')then read(key(50:61),*)nstam write(6,1001)key if(nstam.gt.nao)call report('too many shell shell to atom') read(2,2003)(istam(i),i=1,nstam) endif if(key(1:19).eq.'Primitive exponents')then read(key(50:61),*)npe write(6,1001)key deallocate(rpe) allocate(rpe(npe)) read(2,2004)(rpe(i),i=1,npe) 2004 format(5E16.8) endif if(key(1:24).eq.'Contraction coefficients')then read(key(50:61),*)ncc write(6,1001)key deallocate(rcc) allocate(rcc(ncc)) read(2,2004)(rcc(i),i=1,ncc) read(2,1001)key if(key(1:31).ne.'P(S=P) Contraction coefficients')then ncl=0 rcl(1)=0.0d0 if(nst.gt.0.and.npps.gt.0.and.nstam.gt.0.and.npe.gt.0. 1 and.ncc.gt.0)then call getbasisfck(nao,nat,nop,nor,ish,ld5,lf7,lg9,lh11,li13, 1 ty,cc,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha, 2 nxig,nyig,nzig,nxih,nyih,nzih,nxii,nyii,nzii,rcp, 3 nst,ist,ipps,istam,rpe,rcc,rcl) ibasis=ibasis+1 else write(6,*)nst,npps,nstam,npe,ncc,ncl call report('incomplete basis set input') endif endif endif if(key(1:31).eq.'P(S=P) Contraction coefficients')then read(key(50:61),*)ncl deallocate(rcl) allocate(rcl(ncl)) read(2,2004)(rcl(i),i=1,ncl) if(nst.gt.0.and.npps.gt.0.and.nstam.gt.0.and.npe.gt.0. 1 and.ncc.gt.0.and.ncl.gt.0)then call getbasisfck(nao,nat,nop,nor,ish,ld5,lf7,lg9,lh11,li13, 1 ty,cc,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha, 2 nxig,nyig,nzig,nxih,nyih,nzih,nxii,nyii,nzii,rcp, 3 nst,ist,ipps,istam,rpe,rcc,rcl) ibasis=ibasis+1 else write(6,*)nst,npps,nstam,npe,ncc,ncl call report('incomplete basis set input') endif endif c (end of Gaussian checkpoint) c if(ibasis.gt.0)idif=ieigen-1 c if(idif.eq.ndiff.and.ibasis.gt.0)return goto 111 666 close(2) write(6,4004)idif,ieigen,igeo,ibasis 4004 format(I4,' point of the differentiation:',/, 1 '----', ' -----------------------------',/, 2 ' Eigenvectors read',I4,' times',/, 3 ' Geometry read ',I4,' times',/, 4 ' Basis read ',I4,' times',/) if(igeo.eq.0)call report('geometry not found') if(ibasis.eq.0)call report('basis not found') if(ieigen.eq.0)call report('eigenvectors not found') return end c ============================================================== function ein(n,a) c int(x**n*exp(-2*a*x**2),x=-inf..inf) implicit none integer*4 n,i real*8 ein,a,b,as,pi,spt,bohr common/const/pi,spt,bohr b=1.0d0 i=1 1 b=b*dble(i) i=i+2 if(i.le.n-1)goto 1 as=dsqrt(a) ein=b*sqrt(2.0d0*pi)/(as*2.0d0)**(n+1) return end c ============================================================== subroutine getbasis(nao,nat,nop,nor,ish,ld5,lf7,lg9,lh11,li13, 1 ty,cc,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha, 1 nxig,nyig,nzig,nxih,nyih,nzih,nxii,nyii,nzii,rcp,rcd) implicit none integer*4 nao,nat,i,nop(*),k,nor,ish(nat,nor),is, 1ishell,ip,ndao,ii,L,nb,ix,iy,iz,nxig(15),nyig(15), 1nzig(15),nxih(21),nyih(21),nzih(21),nxii(28),nyii(28),nzii(28) real*8 sf,af,ccs(nat,nor),ccp(nat,nor),cc(nat,nor), 1ccd(nat,nor,2),ccf(nat,nor,3),cci_G(nat,nor,15), 1cci_H(nat,nor,21),cci_I(nat,nor,28),alpha(nat,nor), 1a,SNO,pi,spt,bohr,SNP,SND,SNF1,SNF2,SNF3,SNDD, 1rcp(nat,nor),ein,rcd(nat,nor) character*3 s3 character*80 s80 character*1 ty(nat,nor) logical ld5,lf7,lg9,lh11,li13 common/const/pi,spt,bohr nao=0 do 3 i=1,nat nop(i)=0 do 1 k=1,nor 1 ish(i,k)=32000 ishell=0 read(2,*) 50000 read(2,280)s80 280 format(a80) s3=s80(2:4) c treat variable Gaussian ouput, eg c D 1 1.00 0.000000000000 c SP 3 1.00 0.000000000000 c SPD 6 1.00 0.000000000000: do 7 is=2,10 7 if(s80(is:is).eq.' ')goto 77 77 read(s80(is:len(s80)),*)ip,sf ishell=ishell+1 ndao=-90 if(s3.eq.'SP ')ndao=4 if(s3.eq.'P ')ndao=3 if(s3.eq.'S ')ndao=1 if(s3.eq.'D ')ndao=6 if(s3.eq.'D '.and.ld5)ndao=5 if(s3.eq.'F ')ndao=10 if(s3.eq.'F '.and.lf7)ndao=7 if(s3.eq.'G ')ndao=15 if(s3.eq.'G '.and.lg9)ndao=9 if(s3.eq.'H ')ndao=21 if(s3.eq.'H '.and.lh11)ndao=11 if(s3.eq.'I ')ndao=28 if(s3.eq.'I '.and.li13)ndao=13 if(s3.eq.'SPD')ndao=10 if(s3.eq.'SPD'.and.ld5)ndao=9 if(ndao.eq.-90)call report('Unknown shell '//s3//'!') nao=nao+ndao do 2 ii=1,ip nop(i)=nop(i)+1 k=nop(i) if(k.gt.nor)call report('Too many primitives on one atom') if(s3.eq.'S ')ty(i,k)='S' if(s3.eq.'SP ')ty(i,k)='L' if(s3.eq.'D ')ty(i,k)='D' if(s3.eq.'P ')ty(i,k)='P' if(s3.eq.'F ')ty(i,k)='F' if(s3.eq.'G ')ty(i,k)='G' if(s3.eq.'H ')ty(i,k)='H' if(s3.eq.'I ')ty(i,k)='I' if(s3.eq.'SPD')ty(i,k)='M' if(s3.eq.'SPD')then read(2,*)af,ccs(i,k),ccp(i,k),cc(i,k) else if(s3.eq.'SP ')then read(2,*)af,ccs(i,k),ccp(i,k) else read(2,*)af,cc(i,k) endif endif af=af*sf**2 alpha(i,k)=af ish(i,k)=ishell c SNO normalization factor to S: a=dble(2)*af/pi SNO=sqrt(sqrt(a*a*a)) c c SNP normalization factor for P: a=af a=dble(128)*a*a*a*a*a/(pi*pi*pi) SNP=sqrt(sqrt(a)) c c SND,SNDD normalization factors for D: a=af a=dble(2048)*a*a*a*a*a*a*a/(pi*pi*pi) SND=sqrt(sqrt(a)) SNDD=SND/sqrt(dble(3)) c c SNFx normalization factors for F(fxxx,fxxy,fxyz): a=dble(2)*af a=sqrt( dble(8)*sqrt(a*a*a*a*a*a*a*a*a)/sqrt(pi*pi*pi) ) SNF1=a/sqrt(dble(15)) SNF2=a/sqrt(dble(3)) SNF3=a c c Higher-anglular momentum functions (G,H,I): c G: a=af L=4 nb=0 do 5 ix=0,L do 5 iy=0,L-ix do 5 iz=0,L-ix-iy if(ix+iy+iz.eq.L)then nb=nb+1 nxig(nb)=ix nyig(nb)=iy nzig(nb)=iz cci_G(i,k,nb)=cc(i,k) 1 /dsqrt(ein(2*ix,a)*ein(2*iy,a)*ein(2*iz,a)) endif 5 continue c c H: L=5 nb=0 do 4 ix=0,L do 4 iy=0,L-ix do 4 iz=0,L-ix-iy if(ix+iy+iz.eq.L)then nb=nb+1 nxih(nb)=ix nyih(nb)=iy nzih(nb)=iz cci_H(i,k,nb)=cc(i,k) 1 /dsqrt(ein(2*ix,a)*ein(2*iy,a)*ein(2*iz,a)) endif 4 continue c c I: L=6 nb=0 do 6 ix=0,L do 6 iy=0,L-ix do 6 iz=0,L-ix-iy if(ix+iy+iz.eq.L)then nb=nb+1 nxii(nb)=ix nyii(nb)=iy nzii(nb)=iz cci_I(i,k,nb)=cc(i,k) 1 /dsqrt(ein(2*ix,a)*ein(2*iy,a)*ein(2*iz,a)) endif 6 continue c ccd(i,k,1)=cc(i,k)*SNDD ccd(i,k,2)=cc(i,k)*SND c ccf(i,k,1)=cc(i,k)*SNF1 ccf(i,k,2)=cc(i,k)*SNF2 ccf(i,k,3)=cc(i,k)*SNF3 c c if(s3.eq.'SP ')then c store exp coef. for control listing: cc(i,k)=ccs(i,k) rcp(i,k)=ccp(i,k) ccs(i,k)=ccs(i,k)*SNO ccp(i,k)=ccp(i,k)*SNP else if(s3.eq.'SPD')then ccs(i,k)=ccs(i,k)*SNO ccp(i,k)=ccp(i,k)*SNP rcp(i,k)=ccp(i,k) rcd(i,k)=cc(i,k) else ccs(i,k)=cc(i,k)*SNO ccp(i,k)=cc(i,k)*SNP endif endif if(ty(i,k).eq.'D')cc(i,k)=ccd(i,k,1)/SNDD 2 if(ty(i,k).eq.'P')cc(i,k)=ccp(i,k)/SNP read(2,3336)s3 3336 format(1x,a3) if(s3.ne.'***')then backspace 2 goto 50000 endif 3 continue write(6,*) 'G94 standard basis loaded from output' write(6,*) nao,' AOs' return end c ============================================================ function number(s) character*(*) s logical number number=s.eq.'1'.or.s.eq.'2'.or.s.eq.'3'.or.s.eq.'4'.or.s.eq.'5' 1 .or.s.eq.'6'.or.s.eq.'7'.or.s.eq.'8'.or.s.eq.'9'.or.s.eq.'0' return end c ============================================================ subroutine readorb(key,nori,e,cij,nao,cdimension) implicit none integer*4 i,j,i1,j1,i2,nao,nori,ic,cdimension real*8 e(*),cij(cdimension,cdimension) logical number character*50 key character*160 s160 i=1 read(2,*) 377 j=i+4 if(key(8:11).ne.'MOs:'.and.key(7:10).ne.'MOs:')read(2,*) if(j.gt.nori)j=nori c c to enable reading of various formats, use s160: read(2,160)s160 160 format(a160) c c add space before negative numbers: i1=22 3775 if(s160(i1:i1).eq.'-'.and.s160(i1-1:i1-1).ne.'E')then do 1 j1=160,i1+1,-1 1 s160(j1:j1)=s160(j1-1:j1-1) s160(i1:i1)=' ' i1=i1+1 endif i1=i1+1 if(i1.lt.160)goto 3775 read(s160(22:160),*,end=777,err=777)(e(i1),i1=i,j) do 39 i2=1,nao read(2,160)s160 c add space before negative numbers: ic=0 i1=22 3776 if(s160(i1:i1).eq.'-'. 1and.number(s160(i1-1:i1-1)).and.number(s160(i1+1:i1+1)))then ic=ic+1 write(6,*) s160(j1-1:j1-1) do 2 j1=160,i1+1,-1 2 s160(j1:j1)=s160(j1-1:j1-1) s160(i1:i1)=' ' i1=i1+1 endif i1=i1+1 if(i1.lt.160)goto 3776 if(ic.gt.0)then write(6,*)'Corrected:',ic write(6,160)s160 endif 39 read(s160(22:160),*,err=99)(cij(i1,i2),i1=i,j) if(j.lt.nori)then i=i+5 read(2,*) goto 377 endif write(6,*)'MOs read' return 99 write(6,160)s160 write(6,*)i2,i,j call report('input error') 777 write(6,160)s160 write(6,*)' nori: ',nori write(6,*)' nao: ',nao write(6,*)' i j: ',i,j call report('error in reading of orbital energies') end c ============================================================== subroutine rdps(nat,ipse) c read pseudopotential parameters implicit none character*29 s29 integer*4 i,nat,ipse(*) read(2,*) read(2,*) read(2,*) read(2,*) i=0 1 read(2,200)s29 200 format(a29) if(s29(15:16).eq.' ')goto 1 if(s29(15:16).eq.'==')return i=i+1 if(i.gt.nat)call report('pseudopotential reading error') if(s29(28:29).eq.' ')then ipse(i)=0 else read(s29(20:29),*)ipse(i) endif goto 1 end c ============================================================== subroutine getbasisfck(nao,nat,nop,nor,ish,ld5,lf7,lg9,lh11,li13, 1 ty,cc,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,alpha, 1 nxig,nyig,nzig,nxih,nyih,nzih,nxii,nyii,nzii,rcp, 3 nst,ist,ipps,istam,rpe,rcc,rcl) implicit none integer*4 nao,nat,i,nop(*),k,nor,ish(nat,nor), 1ishell,ip,ndao,L,nb,ix,iy,iz,nxig(15),nyig(15),isa, 1nzig(15),nxih(21),nyih(21),nzih(21),nxii(28),nyii(28),nzii(28) real*8 af,ccs(nat,nor),ccp(nat,nor),cc(nat,nor), 1ccd(nat,nor,2),ccf(nat,nor,3),cci_G(nat,nor,15), 1cci_H(nat,nor,21),cci_I(nat,nor,28),alpha(nat,nor), 1a,SNO,pi,spt,bohr,SNP,SND,SNF1,SNF2,SNF3,SNDD, 1rcp(nat,nor),ein character*2 s2 character*1 ty(nat,nor) logical ld5,lf7,lg9,lh11,li13 common/const/pi,spt,bohr integer*4 nst,ist(*),ipps(*),istam(*),ipt real*8 rpe(*),rcc(*),rcl(*) nao=0 do 1 i=1,nat nop(i)=0 do 1 k=1,nor 1 ish(i,k)=32000 c c number of shells on one atom: isa=0 c total number of primitive functions: ipt=0 c loop over shells: write(6,6019) 6019 format('shell primitive primitive atom exponent:') do 2 ishell=1,nst isa=isa+1 s2='XX' if(ist(ishell).eq.-1)s2='SP' if(ist(ishell).eq. 0)s2='S ' if(ist(ishell).eq. 1)s2='P ' if(ist(ishell).eq.-2)s2='D ' if(ist(ishell).eq. 2)s2='D ' if(ist(ishell).eq. 3)s2='F ' if(ist(ishell).eq.-3)s2='F ' if(ist(ishell).eq. 4)s2='G ' if(ist(ishell).eq.-4)s2='G ' if(ist(ishell).eq. 5)s2='H ' if(ist(ishell).eq.-5)s2='H ' if(ist(ishell).eq. 6)s2='I ' if(ist(ishell).eq.-6)s2='I ' if(s2.eq.'XX')then write(6,*)ist(ishell) call report('unknown shell type') endif if(s2.eq.'SP')ndao=4 if(s2.eq.'P ')ndao=3 if(s2.eq.'S ')ndao=1 if(s2.eq.'D ')ndao=6 if(s2.eq.'D '.and.ld5)ndao=5 if(s2.eq.'F ')ndao=10 if(s2.eq.'F '.and.lf7)ndao=7 if(s2.eq.'G ')ndao=15 if(s2.eq.'G '.and.lg9)ndao=9 if(s2.eq.'H ')ndao=21 if(s2.eq.'H '.and.lh11)ndao=11 if(s2.eq.'I ')ndao=28 if(s2.eq.'I '.and.li13)ndao=13 nao=nao+ndao c shell atom: i=istam(ishell) if(ishell.gt.1)then if(i.ne.istam(ishell-1))isa=1 endif if(i.lt.0.and.i.gt.nat)call report('wrong shell atom assignment') c loop over primitives do 2 ip=1,ipps(ishell) ipt=ipt+1 nop(i)=nop(i)+1 k=nop(i) if(k.gt.nor)call report('Too many primitives on one atom') if(s2.eq.'S ')ty(i,k)='S' if(s2.eq.'SP')ty(i,k)='L' if(s2.eq.'D ')ty(i,k)='D' if(s2.eq.'P ')ty(i,k)='P' if(s2.eq.'F ')ty(i,k)='F' if(s2.eq.'G ')ty(i,k)='G' if(s2.eq.'H ')ty(i,k)='H' if(s2.eq.'I ')ty(i,k)='I' c primitive exponent: af=rpe(ipt) alpha(i,k)=af write(6,6009)ishell,ip,ipt,i,af 6009 format(i5,2i10,i5,g20.6) c contraction coefficients: if(s2.eq.'SP')then ccs(i,k)=rcc(ipt) ccp(i,k)=rcl(ipt) else cc(i,k)=rcc(ipt) endif c normalization factors: a=dble(2)*af/pi SNO=sqrt(sqrt(a*a*a)) a=af a=dble(128)*a*a*a*a*a/(pi*pi*pi) SNP=sqrt(sqrt(a)) a=af a=dble(2048)*a*a*a*a*a*a*a/(pi*pi*pi) SND=sqrt(sqrt(a)) SNDD=SND/sqrt(dble(3)) ccd(i,k,1)=cc(i,k)*SNDD ccd(i,k,2)=cc(i,k)*SND a=dble(2)*af a=sqrt( dble(8)*sqrt(a*a*a*a*a*a*a*a*a)/sqrt(pi*pi*pi) ) SNF1=a/sqrt(dble(15)) SNF2=a/sqrt(dble(3)) SNF3=a ccf(i,k,1)=cc(i,k)*SNF1 ccf(i,k,2)=cc(i,k)*SNF2 ccf(i,k,3)=cc(i,k)*SNF3 a=af L=4 nb=0 do 5 ix=0,L do 5 iy=0,L-ix do 5 iz=0,L-ix-iy if(ix+iy+iz.eq.L)then nb=nb+1 nxig(nb)=ix nyig(nb)=iy nzig(nb)=iz cci_G(i,k,nb)=cc(i,k) 1 /dsqrt(ein(2*ix,a)*ein(2*iy,a)*ein(2*iz,a)) endif 5 continue L=5 nb=0 do 4 ix=0,L do 4 iy=0,L-ix do 4 iz=0,L-ix-iy if(ix+iy+iz.eq.L)then nb=nb+1 nxih(nb)=ix nyih(nb)=iy nzih(nb)=iz cci_H(i,k,nb)=cc(i,k) 1 /dsqrt(ein(2*ix,a)*ein(2*iy,a)*ein(2*iz,a)) endif 4 continue L=6 nb=0 do 6 ix=0,L do 6 iy=0,L-ix do 6 iz=0,L-ix-iy if(ix+iy+iz.eq.L)then nb=nb+1 nxii(nb)=ix nyii(nb)=iy nzii(nb)=iz cci_I(i,k,nb)=cc(i,k) 1 /dsqrt(ein(2*ix,a)*ein(2*iy,a)*ein(2*iz,a)) endif 6 continue if(s2.eq.'SP')then c store exp coef. for control listing: cc(i,k)=ccs(i,k) rcp(i,k)=ccp(i,k) ccs(i,k)=ccs(i,k)*SNO ccp(i,k)=ccp(i,k)*SNP else ccs(i,k)=cc(i,k)*SNO ccp(i,k)=cc(i,k)*SNP endif if(ty(i,k).eq.'D')cc(i,k)=ccd(i,k,1)/SNDD if(ty(i,k).eq.'P')cc(i,k)=ccp(i,k)/SNP 2 ish(i,k)=isa c write(6,*) 'basis loaded from checkpoint' write(6,*) nao,' AOs' return end subroutine writecon(ndiff,ichm,nat,nao,ndo,nmo,noe,nsa,nsb,zsum, 1ish,alpha,nop,ty,cc,rcp,rcd,e,be,z,xv,at,aot,iat,isha, 1ld5,lf7,lg9,lh11,li13) c writes control output implicit real*8 (a-h,o-z) implicit integer*4 (i-n) parameter (nor=80) dimension alpha(nat,nor),nop(*),cc(nat,nor),rcp(nat,nor),e(*), 1be(*),z(*),xv(3,nat),iat(*),isha(*),rcd(nat,nor) common/const/pi,spt,bohr character*3 aot(*) character*2 at(nat) character*1 ty(nat,nor) logical ld5,lf7, 1ld2,XYZ,ABINI,CC5,LAN,LDO,lsp, 1lg9,lh11,li13, 9lopt,lturbo equivalence (lopt(68),lturbo) common/opts/lopt(300),icha equivalence 1(lopt(9),ld2 ), 1(lopt(13),XYZ ),(lopt(14),ABINI ),(lopt(15),cc5 ), 1(lopt(16),lan ),(lopt(17),ldo ), 1(lopt(19),lsp ) common/iopts/iopt(300) equivalence (iopt(1),ncnmr),(iopt(2),inormo ),(iopt(3),nek1 ), 1 (iopt(4),nek2 ),(iopt(5),nej1 ),(iopt(6),nej2 ), 1 (iopt(7),ioe ),(iopt(8),nstart ),(iopt(9),nend ), 1 (iopt(10),nprc),(iopt(11),multi ),(iopt(12),ndog ), 1 (iopt(13),nsi ),(iopt(14),nconfig),(iopt(15),nproc ), 1 (iopt(16),neci),(iopt(17),idiago ),(iopt(18),igradc), 1 (iopt(19),nev ),(iopt(20),mmit ),(iopt(21),iham ), 1 (iopt(22),ncut),(iopt(23),nk ),(iopt(24),nj ) integer*4 iat,isha,ish(nat,nor) parameter (nshtypes=49) character*3 shtypes(nshtypes) data shtypes/'s ','px ','py ','pz ','d0 ','d1a','d1b', 1 'd2a','d2b', 1'f 0','f+1','f-1','f+2','f-2','f+3','f-3', 2'g 0','g+1','g-1','g+2','g-2','g+3','g-3','g+4','g-4', 2'h 0','h+1','h-1','h+2','h-2','h+3','h-3','h+4','h-4','h+5','h-5', 2'i 0','i+1','i-1','i+2','i-2','i+3','i-3','i+4','i-4','i+5','i-5', 2'i+6','i-6'/ character*1 spd(7) data spd/'s','p','d','f','g','h','i'/ c mtp=multi if(ndiff.eq.0)then write(6,*) 'MOLECULAR PARAMETERS' write(6,*) '------------------------------------------' write(6,*) 'Number of basis functions : ',nao write(6,*) 'Number of electrons : ',noe write(6,*) 'Charge : ',ichm write(6,*) 'Multiplicity : ',mtp write(6,*) 'Number of doubly occupied orbitals : ',ndo write(6,*) 'Number of singly occupied a-orbitals: ',nsa write(6,*) 'Number of singly occupied b-orbitals: ',nsb write(6,*) 'Number of atoms : ',nat write(6,*) 'Sum of atomic charges : ',int(zsum) write(6,*) write(6,*) iao=1 do 1 i=1,nat write(6,4000) i,nop(i) 4000 format(I6,' atom, ',I4,' primitive functions:',/, 1' shell prim alpha expansion P-expansion', 2' D-expansion',' AO range') do 1 j=1,nop(i) if(ish(i,j+1).gt.ish(i,j))then idel=0 if(ty(i,j).eq.'S')then idel=1 aot(iao)='s ' endif if(ty(i,j).eq.'P')then idel=3 aot(iao )='px ' aot(iao+1)='py ' aot(iao+2)='pz ' endif if(ty(i,j).eq.'L')then idel=4 aot(iao )='s ' aot(iao+1)='px ' aot(iao+2)='py ' aot(iao+3)='pz ' endif if(ty(i,j).eq.'D'.and.ld5)then idel=5 aot(iao )='d0 ' aot(iao+1)='d1a' aot(iao+2)='d1b' if(lturbo)then aot(iao+3)='d2a' aot(iao+4)='d2b' else aot(iao+3)='d2b' aot(iao+4)='d2a' endif endif if(ty(i,j).eq.'D'.and..not.ld5)then idel=6 aot(iao )='xx ' aot(iao+1)='yy ' aot(iao+2)='zz ' aot(iao+3)='xy ' aot(iao+4)='xz ' aot(iao+5)='yz ' endif c SPD: if(ty(i,j).eq.'M')then aot(iao)='s ' aot(iao+1)='px ' aot(iao+2)='py ' aot(iao+3)='pz ' if(ld5)then idel=9 aot(iao+4)='d0 ' aot(iao+5)='d1a' aot(iao+6)='d1b' aot(iao+7)='d2b' aot(iao+8)='d2a' else idel=10 aot(iao+4)='xx ' aot(iao+5)='yy ' aot(iao+6)='zz ' aot(iao+7)='xy ' aot(iao+8)='xz ' aot(iao+9)='yz ' endif endif if(ty(i,j).eq.'F'.and.lf7)then idel=7 aot(iao )='f 0' aot(iao+ 1)='f+1' aot(iao+ 2)='f-1' aot(iao+ 3)='f+2' aot(iao+ 4)='f-2' aot(iao+ 5)='f+3' aot(iao+ 6)='f-3' endif if(ty(i,j).eq.'F'.and..not.lf7)then L=3 idel=10 aot(iao )='xxx' aot(iao+ 1)='yyy' aot(iao+ 2)='zzz' aot(iao+ 3)='xxy' aot(iao+ 4)='xxz' aot(iao+ 5)='yyx' aot(iao+ 6)='yyz' aot(iao+ 7)='zzx' aot(iao+ 8)='zzy' aot(iao+ 9)='xyz' endif if(ty(i,j).eq.'G')then L=4 idel=0 if(lg9)then do 6 m=0,L ipend=2 if(m.eq.0)ipend=1 do 6 ip=1,ipend aot(iao+idel)(1:1)=spd(L+1) if(ip.eq.1)then aot(iao+idel)(2:2)='+' else aot(iao+idel)(2:2)='-' endif if(ipend.eq.1)aot(iao+idel)(2:2)=' ' write(aot(iao+idel)(3:3),'(i1)')m 6 idel=idel+1 else do 7 ix=0,L do 7 iy=0,L-ix iz=L-ix-iy write(aot(iao+idel)(1:1),'(i1)')ix write(aot(iao+idel)(2:2),'(i1)')iy write(aot(iao+idel)(3:3),'(i1)')iz 7 idel=idel+1 endif endif if(ty(i,j).eq.'H')then L=5 idel=0 if(lh11)then do 61 m=0,L ipend=2 if(m.eq.0)ipend=1 do 61 ip=1,ipend aot(iao+idel)(1:1)=spd(L+1) if(ip.eq.1)then aot(iao+idel)(2:2)='+' else aot(iao+idel)(2:2)='-' endif if(ipend.eq.1)aot(iao+idel)(2:2)=' ' write(aot(iao+idel)(3:3),'(i1)')m 61 idel=idel+1 else do 71 ix=0,L do 71 iy=0,L-ix iz=L-ix-iy write(aot(iao+idel)(1:1),'(i1)')ix write(aot(iao+idel)(2:2),'(i1)')iy write(aot(iao+idel)(3:3),'(i1)')iz 71 idel=idel+1 endif endif if(ty(i,j).eq.'I')then L=6 idel=0 if(li13)then do 62 m=0,L ipend=2 if(m.eq.0)ipend=1 do 62 ip=1,ipend aot(iao+idel)(1:1)=spd(L+1) if(ip.eq.1)then aot(iao+idel)(2:2)='+' else aot(iao+idel)(2:2)='-' endif if(ipend.eq.1)aot(iao+idel)(2:2)=' ' write(aot(iao+idel)(3:3),'(i1)')m 62 idel=idel+1 else do 72 ix=0,L do 72 iy=0,L-ix iz=L-ix-iy write(aot(iao+idel)(1:1),'(i1)')ix write(aot(iao+idel)(2:2),'(i1)')iy write(aot(iao+idel)(3:3),'(i1)')iz 72 idel=idel+1 endif endif do 200 k=0,idel-1 200 iat(iao+k)=i if(idel.eq.0)call report('uknown shell '//ty(i,j)) write(6,10002)ish(i,j),ty(i,j),j,alpha(i,j),cc(i,j) 10002 format(1x,i4,a1,I5,2f14.5,$) if(ty(i,j).eq.'L'.or.ty(i,j).eq.'M')write(6,10003)rcp(i,j) 10003 format(f14.5,$) if(ty(i,j).eq.'M')write(6,10003)rcd(i,j) write(6,10005)iao,iao+idel-1 10005 format(I4,' - ',I4) iao=iao+idel else write(6,10002)ish(i,j),ty(i,j),j,alpha(i,j),cc(i,j) if(ty(i,j).eq.'L'.or.ty(i,j).eq.'M')write(6,10003)rcp(i,j) if(ty(i,j).eq.'M')write(6,10003)rcd(i,j) write(6,*) endif 1 continue endif c Turbomole shell numbering - restarts each atom, separate for each shell do ii=1,nshtypes iaold=0 isn=0 do i=1,nao if(iat(i).ne.iaold)isn=0 if(aot(i).eq.shtypes(ii))then isn=isn+1 isha(i)=isn endif iaold=iat(i) enddo enddo if(nao.gt.nao)call report('Too many basis functions') write(6,*)' AO type atom shell' do 5 i=1,nao 5 write(6,300)i,aot(i),iat(i),isha(i) 300 format(i5,1x,a3,1x,2i4) c write(6,*)'Alpha' i=1 nori=ndo if(nmo.gt.0)nori=nmo 777 j=i+4 if(j.gt.nori)j=nori write(6,1005)(e(i1),i1=i,j) 1005 format(12x,5f13.6) if(j.lt.nori)then i=i+5 goto 777 endif c write(6,*)'Beta' i=1 7771 j=i+4 if(j.gt.nori)j=nori write(6,1005)(be(i1),i1=i,j) if(j.lt.nori)then i=i+5 goto 7771 endif c open(31,file='GEO.X') write(6,*)'Geometry (A): ' write(31,*)'Geometry (A): ' write(31,*)nat do 112 i=1,nat write(31,11021)int(z(i)),(bohr*xv(j,i),j=1,3) 11021 format(i3,3f16.6,' 0 0 0 0 0 0 0 0.0') 112 write(6,1102)at(i),i,(bohr*xv(j,i),j=1,3),z(i) 1102 format(1x,a2,i6,3f16.6,f8.2) close(31) c return end subroutine normorb(nat,nao,ccs,ccp,ccd,ccf,cci_G,cci_H, 1cci_I,ty,xv,nop,alpha,ish, 1ld5,lf7,lg9,lh11,li13) implicit real*8 (a-h,o-z) implicit integer*4 (i-n) parameter (nor=80) character*1 ty(nat,nor) integer*4 u0 parameter (u0=28) integer*4 nop(*),ish(nat,nor) real*8 ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28),xv(3,nat),alpha(nat,nor) common/const/pi,spt,bohr common/numbers/z0,one,two,three,four,five,half,a10 dimension nxi(u0),nyi(u0),nzi(u0), 1nxj(u0),nyj(u0),nzj(u0),cci(u0),ccj(u0), 3sv(u0,nao),b6(u0,u0),aai(u0,u0),aaj(u0,u0), 4aad(u0,u0),aaf(u0,u0),aa1(u0,u0), 4aag(u0,u0),aah(u0,u0),aaii(u0,u0) logical ld5,lf7,lg9,lh11,li13 dimension anorm(nao) c call inipoly i0=0 call initfd(aa1,aad,aaf,aag,aah,aaii) c tol=100.0d0 spi=sqrt(pi*pi*pi) do 10 i=1,nao anorm(i)=z0 do 10 j=1,u0 10 sv(j,i)=z0 write(6,4000)nao,nat 4000 format(I4,' orbitals read in',I4,' atoms') C c first loop, determine norms: io=0 do 2 ia=1,nat xi=xv(1,ia) yi=xv(2,ia) zi=xv(3,ia) do 3 ip=1,nop(ia) ai=alpha(ia,ip) call nppp(ty(ia,ip),npi,npii,cci,nxi,nyi,nzi, 1aai,aa1,aad,aaf,aag,aah,aaii,ld5,lf7,ia,ip,lg9,lh11,li13, 1nat,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I) if(npi.gt.u0)call report('npi > u0') jo=0 do 4 ja=1,nat xj=xv(1,ja) yj=xv(2,ja) zj=xv(3,ja) xij=xj-xi yij=yj-yi zij=zj-zi x2ij=xij*xij y2ij=yij*yij z2ij=zij*zij r2ij=x2ij+y2ij+z2ij do 5 jp=1,nop(ja) aj=alpha(ja,jp) call nppp(ty(ja,jp),npj,npjj,ccj,nxj,nyj,nzj, 1aaj,aa1,aad,aaf,aag,aah,aaii,ld5,lf7,ja,jp,lg9,lh11,li13, 1nat,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I) aij=ai+aj tt=one/aij t=sqrt(tt) ec=ai*aj*r2ij*tt ef=z0 if(ec.lt.tol)then ef=spi*exp(-ec) else goto 777 endif c C Loop over orbitals to which the primitives ip, jp contribute do 71 joo=1,npj con=ef*ccj(joo) do 71 ioo=1,npi coe=con*cci(ioo) sx=oi(i0,nxi(ioo),nxj(joo),ai,aj,xij,t,xi,xj) sy=oi(i0,nyi(ioo),nyj(joo),ai,aj,yij,t,yi,yj) sz=oi(i0,nzi(ioo),nzj(joo),ai,aj,zij,t,zi,zj) 71 b6(ioo,joo)=sx*sy*sz*coe c if(npi.ne.npii.or.npjj.ne.npj)then do 74 ioo=1,npii do 74 joo=1,npjj ioj=joo+jo do 74 ipp=1,npi aiii=aai(ioo,ipp) do 74 jpp=1,npj ajjj=aaj(joo,jpp)*aiii 74 sv(ioo,ioj)=sv(ioo,ioj)+ajjj*b6(ipp,jpp) else do 7 ioo=1,npi do 7 joo=1,npj ioj=joo+jo 7 sv(ioo,ioj)=sv(ioo,ioj)+b6(ioo,joo) endif c 777 if(ish(ja,jp+1).gt.ish(ja,jp)) jo=jo+npjj c 5 continue 4 continue C if(ish(ia,ip+1).gt.ish(ia,ip))then c if last primitive of the orbitals io+1 ... io+npii, then write them do 33 ii=1,npii iorb=ii+io 33 anorm(iorb)=sv(ii,iorb) io=io+npii do 9 ii=1,u0 do 9 jj=1,nao 9 sv(ii,jj)=z0 endif 3 continue 2 continue c write(6,*)'atomic orbital norms before normalization:' write(6,3000)(anorm(i),i=1,nao) 3000 format(6f12.6) c c second loop, normalize C atom i, orbital io io=0 fac=1.0d0/sqrt(anorm(1)) do 8 ia=1,nat do 6 ip=1,nop(ia) call nppp(ty(ia,ip),npi,npii,cci,nxi,nyi,nzi, 1aai,aa1,aad,aaf,aag,aah,aaii,ld5,lf7,ia,ip,lg9,lh11,li13, 1nat,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I) ccs(ia,ip )=ccs(ia,ip )*fac ccp(ia,ip )=ccp(ia,ip )*fac ccd(ia,ip,1)=ccd(ia,ip,1)*fac ccd(ia,ip,2)=ccd(ia,ip,2)*fac ccf(ia,ip,1)=ccf(ia,ip,1)*fac ccf(ia,ip,2)=ccf(ia,ip,2)*fac ccf(ia,ip,3)=ccf(ia,ip,3)*fac do i1=1,15 cci_G(ia,ip,i1)=cci_G(ia,ip,i1)*fac enddo do i1=1,21 cci_H(ia,ip,i1)=cci_H(ia,ip,i1)*fac enddo do i1=1,28 cci_I(ia,ip,i1)=cci_I(ia,ip,i1)*fac enddo if(ish(ia,ip+1).gt.ish(ia,ip))then io=io+npii if(io+1.le.nao)fac=1.0d0/sqrt(anorm(io+1)) endif 6 continue 8 continue return end subroutine report(s) character*(*) s write(6,*)s stop end subroutine readtm(nat,nao,ccs,ccp,ccd,ccf, 1xv,e,be,cij,bij,at,alpha,cc,ish,ichm,mtp,nsa,nsb, 1nop,z,noe, 1 ld5,lf7) c implicit real*8 (a-h,o-z) implicit integer*4 (i-n) c parameter (nor=80) character*2 at(*) character*1 ok,ty(nat,nor) character*80 s80 common/const/pi,spt,bohr common/rundiff/idif,igeo,ibasis,ieigen logical ld5,lf7, 1ld2,lzmat,XYZ,ABINI,CC5,LAN,LDO,lsp, 9lopt,lconfig,lqq common/opts/lopt(300),icha equivalence 1(lopt(9),ld2 ), 1(lopt(13),XYZ ),(lopt(14),ABINI ),(lopt(15),cc5 ), 1(lopt(16),lan ),(lopt(17),ldo ), 1(lopt(19),lsp ), 1(lopt(28),lzmat ),(lopt(65),lconfig) dimension it(nor),xv(3,nat),e(*),be(*),cij(nao,nao),bij(nao,nao), 1alpha(nat,nor),ccd(nat,nor,2),ccf(nat,nor,3),ccs(nat,nor), 1ccp(nat,nor),cc(nat,nor),ish(nat,nor),nop(*),z(*) character*2 tmsy(nat) character*4 statesym c write(6,*)'Turbomole files coord,basis and mos' c id5=6 if7=10 if(ld5)id5=5 if(lf7)if7=7 do 10000 i=1,nao do 10000 j=1,nao bij(i,j)=0.0d0 10000 cij(i,j)=0.0d0 c inquire(file='coord',exist=lqq) if(.not.lqq)call report('coord does not exist') igeo=igeo+1 open(4,file='coord') 1 read(4,4010)ok 4010 format(a1) if(ok.eq.'$')goto 400 goto 1 400 i=0 33 read(4,4010)ok if(ok.eq.'$')goto 401 backspace 4 i=i+1 if(i.gt.nat)call report('too many atoms') read(4,4001)(xv(ix,i),ix=1,3),ok 4001 format(f20.14,2f22.14,6x,a1) z(i)=0.0d0 if(ok.eq.'h')z(i)=1 if(ok.eq.'c')z(i)=6 if(ok.eq.'n')z(i)=7 if(ok.eq.'o')z(i)=8 tmsy(i)(1:1)=ok if(z(i).lt.1)call report('unknown atom') goto 33 401 close(4) nat=i write(6,*)nat,' atoms' c inquire(file='mos',exist=lqq) if(.not.lqq)call report('mos does not exist') statesym='1234' nao=0 ieigen=ieigen+1 open(4,file='mos') naot=0 2 read(4,4009)s80 4009 format(a80) if(s80(16:25).eq.'eigenvalue')goto 299 goto 2 299 i=0 3 i=i+1 if(i.gt.nao)call report('too many eigenvalues') if(s80(7:9).ne.statesym)then naot=naot+nao endif statesym=s80(7:9) read(s80,4002)e(i),nao if(nao.gt.nao)call report('too many orbitals') if(naot+nao.gt.nao)call report('too many tot. orbitals') 4002 format(26x,d20.14,9x,i3) read(4,4003)(cij(i,naot+j),j=1,nao) 4003 format(4d20.14) be(i)=e(i) do 50 j=1,nao 50 bij(i,j+naot)=cij(i,j+naot) read(4,4009)s80 if(s80(1:4).ne.'$end') goto 3 close(4) nori=i nmo=nori nao=nao+naot write(6,*)nmo,' MOs read in, ',nao,' AOs' c inquire(file='basis',exist=lqq) if(.not.lqq)call report('basis does not exist') ibasis=ibasis+1 open(4,file='basis') nao=0 isht=0 c do 4 j=1,nat at(j)=' ' at(j)(1:1)=tmsy(j)(1:1) nop(j)=0 rewind 4 5 read(4,4010)ok if(ok.eq.tmsy(j)(1:1))goto 555 goto 5 555 k=0 7 read(4,4010)ok if(ok.eq.'*')goto 778 goto 7 778 read(4,4005)ipr,ok isht=isht+1 4005 format(i4,2x,a1) if(ok.eq.'s')nao=nao+1 if(ok.eq.'p')nao=nao+3 if(ok.eq.'d')nao=nao+id5 if(ok.eq.'f')nao=nao+if7 do 6 i=1,ipr k=k+1 if(k.gt.nor)call report('Too many primitives on one atom') if(ok.eq.'s')ty(j,k)='S' if(ok.eq.'p')ty(j,k)='P' if(ok.eq.'d')ty(j,k)='D' if(ok.eq.'f')ty(j,k)='F' c c temporarily record angular momentum for arrangement: if(ok.eq.'s')it(k)=0 if(ok.eq.'p')it(k)=1 if(ok.eq.'d')it(k)=2 if(ok.eq.'f')it(k)=3 c ish(j,k)=isht read(4,*)alpha(j,k),cc(j,k) c aa=alpha(j,k) c c SNO normalization factor to S: SNO=sqrt(sqrt( 8.0d0*aa**3/pi**3)) c c SNP normalization factor for P: SNP=sqrt(sqrt( 128.0d0*aa**5/pi**3)) c c SND normalization factor for D: SND=sqrt(sqrt( 2048.0d0*aa**7/pi**3)) SNDD=SND/sqrt(dble(3)) c c SNFx normalization factors for F(fxxx,fxxy,fxyz): SNF=sqrt(sqrt(32786.0d0*aa**9/pi**3)) SNF1=SNF/sqrt(dble(15)) SNF2=SNF/sqrt(dble(3)) SNF3=SNF c ccs(j,k)=cc(j,k)*SNO ccp(j,k)=cc(j,k)*SNP ccd(j,k,1)=cc(j,k)*SNDD ccd(j,k,2)=cc(j,k)*SND ccf(j,k,1)=cc(j,k)*SNF1 ccf(j,k,2)=cc(j,k)*SNF2 ccf(j,k,3)=cc(j,k)*SNF3 6 continue read(4,4010)ok if(ok.ne.'*')then backspace 4 goto 778 endif nop(j)=k write(8,*)k,' primitives for atom ',j c c reorder according to the angular momentum 403 do 402 k=1,nop(j)-1 if(it(k).gt.it(k+1))then call swi( it( k ), it( k+1)) call swi( ish(j,k ), ish(j,k+1)) call swh( ty(j,k ), ty(j,k+1)) call sw8(alpha(j,k ),alpha(j,k+1)) call sw8( cc(j,k ), cc(j,k+1)) call sw8( ccs(j,k ), ccs(j,k+1)) call sw8( ccp(j,k ), ccp(j,k+1)) call sw8( ccd(j,k,1), ccd(j,k+1,1)) call sw8( ccd(j,k,2), ccd(j,k+1,2)) call sw8( ccf(j,k,1), ccf(j,k+1,1)) call sw8( ccf(j,k,2), ccf(j,k+1,2)) call sw8( ccf(j,k,3), ccf(j,k+1,3)) goto 403 endif 402 continue c c adjpust reordered ish ist=ish(j,1) do 405 k=1,nop(j) if(ish(j,k).lt.ist)ist=ish(j,k) 405 it(k)=ish(j,k) c ish(j,1)=ist do 404 k=2,nop(j) if(it(k-1).ne.it(k))ist=ist+1 404 ish(j,k)=ist c 4 continue close(4) write(6,*)nao,' AOs' c zsum=0.0d0 nat=nat do 1000 ia=1,nat 1000 zsum=zsum+z(ia) noe=nint(zsum)-icha ndo=noe/2 ichm=0 mtp=1 nsa=noe-2*ndo nsb=0 c if(ibasis.gt.0)idif=ieigen-1 write(6,4004)idif,ieigen,igeo,ibasis write(6,4004)idif,ieigen,igeo,ibasis 4004 format(I4,' point of the differentiation:',/, 1 '----', ' -----------------------------',/, 2 ' Eigenvectors read',I4,' times',/, 3 ' Geometry read ',I4,' times',/, 4 ' Basis read ',I4,' times',/) close(2) return end c subroutine sw8(a,b) real*8 a,b,c c=a a=b b=c return end c subroutine swi(a,b) integer*4 a,b,c c=a a=b b=c return end c subroutine swh(a,b) character*1 a,b,c c=a a=b b=c return end subroutine inipoly c initializes the Pascal triangle up to the degree nd implicit real*8 (a-h,o-z) implicit integer*4 (i-n) parameter (nd=24) common/poly/pp(nd,nd) one=dble(1) do 1 i=1,nd pp(i,1)=one 1 pp(i,i)=one do 2 i=3,nd do 2 j=2,i-1 2 pp(i,j)=pp(i-1,j-1)+pp(i-1,j) return end subroutine initfd(aa1,aad,aaf,aag,aah,aai) implicit real*8 (a-h,o-z) implicit integer*4 (i-n) integer*4 u0 parameter (u0=28) common/numbers/z0,one,two,three,four,five,half,a10 dimension aa1(u0,u0),aad(u0,u0),aaf(u0,u0) dimension aag(u0,u0),aah(u0,u0),aai(u0,u0) logical lopt,lturbo common/opts/lopt(300),icha equivalence (lopt(68),lturbo) real*8,allocatable::Coef2P(:,:),Coef2C(:,:) c do 77 i=1,u0 do 77 j=1,u0 aa1(i,j)=z0 aad(i,j)=z0 aaf(i,j)=z0 aag(i,j)=z0 aah(i,j)=z0 aai(i,j)=z0 77 aa1(i,i)=one c c Special treatment of the "true" D and F orbitals: c c Ds are calculated in the Cadpac/cartesian order, then transformed c into the G94/spherical form c c G94 order Cadpac order Turbomole order c -------------------------------- c 3z^2-R^2 1 xx d0 = (-xx-yy+2zz)/sqrt(12) c xz 2 yy d1a = xz c yz 3 zz d1b = yz c x^2-y^2 4 xy d2a = xy c xy 5 xz d2b = (xx-yy)/2 c - 6 yz c cartesian versus spherical Ds: c 1 2 3 4 5 6 c xx yy zz xy xz yz c c 1 -d1 -d1 2*d1 0 0 0 c 2 0 0 0 0 1 0 c 3 0 0 0 0 0 1 c 4 d5 -d5 0 0 0 0 c 5 0 0 0 1 0 0 c c |normalized z^2-r^2> = d1*(two*|norm.zz>-|norm.xx>-|norm.yy>) d1=half st=sqrt(three) sf=sqrt(five) c |normalized x^2-y^2> = d5*(|norm.xx>-|norm.yy>) d5=st*half aad(1,1)=-d1 aad(1,2)=-d1 aad(1,3)=two*d1 aad(2,5)=one aad(3,6)=one if(lturbo)then aad(5,1)=d5 aad(5,2)=-d5 aad(4,4)=one else aad(4,1)=d5 aad(4,2)=-d5 aad(5,4)=one endif c C F-orbitals c spherical cartesian c -------------------------------- c 5z^3-3R^2z 1 xxx c x(5z^2-R^2) 2 yyy c y(5z^2-R^2) 3 zzz c xyz 4 xxy c z(x^2-y^2) 5 xxz c y(y^2-3x^2) 6 yyx c x(x^2-3y^2) 7 yyz c - 8 zzx c - 9 zzy c - 10 xyz c cartesian versus spherical Fs: c non-normalized functions in the table: c 1 2 3 4 5 6 7 8 9 10 c xxx yyy zzz xxy xxz yyx yyz zzx zzy xyz c1 0 0 2 0 -3 0 -3 0 0 0 c2 -1 0 0 0 0 -1 0 4 0 0 c3 0 -1 0 -1 0 0 0 0 4 0 c4 0 0 0 0 1 0 -1 0 0 0 c5 0 0 0 0 0 0 0 0 0 1 c6 1 0 0 0 0-1391.72064776868 -3 0 0 0 0 c7 0 -1 0 3 0 0 0 0 0 0 c normalization factors for spherical Fs f1=half/sf f2=half*st/sqrt(a10) f3=half*st/sqrt(a10) f4=st*half f5=one f6=half/sqrt(two) f7=half/sqrt(two) c expansion into normalized cartesians: aaf(1, 3)= f1 * two * sf aaf(1, 5)=-f1 * three aaf(1, 7)=-f1 * three aaf(2, 1)=-f2 * sf aaf(2, 6)=-f2 aaf(2, 8)= f2 * four aaf(3, 2)=-f3 * sf aaf(3, 4)=-f3 aaf(3, 9)= f3 * four aaf(4, 5)= f4 aaf(4, 7)=-f4 aaf(5,10)= f5 aaf(6, 1)= f6 * sf aaf(6, 6)=-f6 * three aaf(7, 2)=-f7 * sf aaf(7, 4)= f7 * three c g,h,i-functions (f for control): DO 1 L=1,6 MCart = ((L+1)*(L+2))/2 MPure = 2*L+1 allocate(Coef2P(MCart,MPure),Coef2C(MCart,MPure)) Call C2PGn1(L,MCart,MPure,Coef2P,Coef2C) ia=0 do 2 m =0,l if(m.eq.0)then imend=1 else imend=2 endif do 2 im=1,imend c im=1 (|lm>+|l-m>/sqrt( 2) c im=2 (|lm>-|l-m>/sqrt(-2) ia=ia+1 ix=0 do 2 Lx=0,L do 2 Ly=0,(L-Lx) c Lz=L-Lx-Ly ix=ix+1 if(L.eq.3)then c write(6,6009)LX,LY,LZ,ix,ia,Coef2P(ix,ia),aaf(ia,ix) c6009 format(3i2,1x,2i3,4f12.6) endif if(L.eq.4)aag(ia,ix)=Coef2P(ix,ia) if(L.eq.5)aah(ia,ix)=Coef2P(ix,ia) 2 if(L.eq.6)aai(ia,ix)=Coef2P(ix,ia) 1 deallocate(Coef2P,Coef2C) return end c ================================================== function c2pcff(L,M,Lx,Ly) implicit integer*4 (i-n) implicit real*8 (a-h,o-z) c c Generate coefficients for conversion from normalized cartesian c gaussians to pure spherical harmonics c c v(L,M) = Sum c2pcff(L,M,Lx,Ly,fac) v(Lx,Ly,Lz) c (Lx=0,L;Ly=0,L-Lx) c c L,M for spherical harmonic c Lx,Ly,Lz=L-Lx-Ly for cartesian c fac(n) = n! c c H. B. Schlegel May 1994 c Save Zero, Two Data Zero/0.D0/, Two/2.D0/ real*8 fac C Lz = L - Lx - Ly Ma = IAbs(M) c2pcff = Zero If(Ma.gt.L.or.Lz.lt.0) Return a = Sqrt(fac(2*Lx)*fac(2*Ly)*fac(2*Lz)*fac(L)/ $ (fac(2*L)*fac(Lx)*fac(Ly)*fac(Lz))) b = Sqrt(fac(L-Ma)/fac(L+Ma))/((2**L)*fac(L)) ilim = (L-Ma)/2 j = (L-Ma-Lz)/2 g = Zero If((2*j).eq.(L-Ma-Lz)) then do 20 i = 0, ilim c = Zero If(j.ge.0.and.j.le.i) then c = (fac(L)/(fac(i)*fac(L-i)))* $ (fac(2*L-2*i)*((-1)**i)/fac(L-Ma-2*i))* $ (fac(i)/(fac(j)*fac(i-j))) do 10 k = 0, j d = Zero If((Lx-2*k).ge.0.and.(Lx-2*k).le.Ma) then d = (fac(j)/(fac(k)*fac(j-k)))* $ (fac(Ma)/(fac(Lx-2*k)*fac(Ma+2*k-Lx))) e = Zero kmLx2 = k - Lx/2 If(M.eq.0.and.mod(Lx,2).eq.0) e=(-1)**kmLx2 kTMaLx = ((2*k+Ma-Lx)/2) If(M.gt.0.and.mod(IAbs(Ma-Lx),2).eq.0) $ e = Sqrt(Two)*(-1)**kTMaLx If(M.lt.0.and.mod(IAbs(Ma-Lx),2).eq.1) $ e = Sqrt(Two)*(-1)**kTMaLx g = g + c*d*e endIf 10 Continue endIf 20 Continue endIf c2pcff = a*b*g Return End c ================================================== c Subroutine C2PGen(LMax,Coef2P,Coef2C) c implicit integer*4 (i-n) c implicit real*8(a-h,o-z) c c Generate the transformation coefficients to transform between c normalized cartesian gaussians to normalized spherical harmonics c c coef2p L(L+1)/2 by (2L+1) blocks of transformation matricies c from cartesian to pure. c coef2c L(L+1)/2 by (2L+1) blocks of transformation matricies c from pure to cartesian. c Individual values coef2p and coef2c are calculated by c2pcff. c fac scratch array, length 2 Lmax + 1 (real) c Lmax highest angular momentum to transform c c The block for L starts at 1+ L(L+1)(L+2)(3L-1)/12, c and within a block, the cartesian index runs fastest c c Pure functions v(L,M) are in the order: c c v(0,0),v(1,0),v(1,1m),v(1,1p),v(2,0),v(2,1m),v(2,1p), etc c c where v(L,ip) = (v(L,i)+v(L,-i))/Sqrt(2) c v(L,im) = (v(L,i)-v(L,-i))/Sqrt(-2) c c Cartesian functions v(Lx,Ly,Lz) are in the Prism order: c c v(0,0,0) c c v(0,0,1),v(0,1,0),v(1,0,0) c c v(0,0,2),v(0,1,1),v(0,2,0),v(1,0,1),v(1,1,0),v(2,0,0) c c v(0,0,3),v(0,1,2),v(0,2,1),v(0,3,0),v(1,0,2),v(1,1,1), c v(1,2,0),v(2,0,1),v(2,1,0),v(3,0,0) c c v(0,0,4),v(0,1,3),v(0,2,2),v(0,3,1),v(0,4,0),v(1,0,3), c v(1,1,2),v(1,2,1),v(1,3,0),v(2,0,2),v(2,1,1),v(2,2,0), c v(3,0,1),v(3,1,0),v(4,0,0) c c etc c c H. B. Schlegel May 1994 c c dimension coef2p(*),coef2c(*) c c loop over L c c Do 20 L = 0, LMax c MCart = ((L+1)*(L+2))/2 c MPure = 2*L+1 c Call C2PGn1(L,MCart,MPure,Coef2P,Coef2C) c 20 Continue c Return c End c ================================================== Subroutine C2PGn1(L,MCart,MPure,Coef2P,Coef2C) Implicit Real*8(A-H,O-Z) implicit integer*4 (i-n) Dimension Coef2P(MCart,MPure), Coef2C(MCart,MPure) real*8 fac c c M=0 case c Coef2C=0.0d0 lxyz = 0 do 10 Lx = 0, L do 10 Ly = 0, (L-Lx) Lz = L-Lx-Ly lxyz = lxyz+1 coef2p(lxyz,1) = c2pcff(L,0,Lx,Ly) Do 10 M = 1, L coef2p(lxyz,2*M) = c2pcff(L,M,Lx,Ly) 10 coef2p(lxyz,2*M+1) = c2pcff(L,-M,Lx,Ly) c c compute the overlap and form coef2c c i = 0 do 230 Lx1 = 0, L do 230 Ly1 = 0, (L-Lx1) Lz1 = L - Lx1 - Ly1 i = i + 1 j = 0 a1 = Sqrt(fac(Lx1)*fac(Ly1)*fac(Lz1)/ $ (fac(2*Lx1)*fac(2*Ly1)*fac(2*Lz1))) do 220 Lx2 = 0, L do 220 Ly2 = 0, (L-Lx2) Lz2 = L - Lx2 - Ly2 j = j + 1 a2 = Sqrt(fac(Lx2)*fac(Ly2)*fac(Lz2)/ $ (fac(2*Lx2)*fac(2*Ly2)*fac(2*Lz2))) Lx = Lx1 + Lx2 Ly = Ly1 + Ly2 Lz = Lz1 + Lz2 if(mod(Lx,2).eq.0.and.mod(Ly,2).eq.0.and.mod(Lz,2).eq.0) $ then s = a1*a2*fac(Lx)*fac(Ly)*fac(Lz)/ $ (fac(Lx/2)*fac(Ly/2)*fac(Lz/2)) do 210 k = 1, mpure 210 coef2c(i,k) = coef2c(i,k)+s*coef2p(j,k) endIf 220 Continue 230 Continue Return End function fac(n) implicit none real*8 fac,f,fi integer*4 n,i f=1.0d0 if(n.lt.2)goto 99 fi=1.0d0 do 1 i=2,n fi=fi+1.0d0 1 f=f*fi 99 fac=f return end subroutine nppp(shell,npi,npii,cci,nxi,nyi,nzi, 1aai,aa1,aad,aaf,aag,aah,aaii,ld5,lf7,ia,ip,lg9,lh11,li13, 1nat,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I) implicit none integer*4 u0,nat,nor,npi,npii,nxi,nyi,nzi, 1ia,ip,i1,i2,nxig,nyig,nzig,nxih,nyih,nzih,nxii,nyii,nzii parameter (u0=28,nor=80) character*1 shell logical ld5,lf7,lg9,lh11,li13 real*8 cci,aai,aa1,aad,aaf,aag,aah,aaii dimension cci(*),nxi(*),nyi(*),nzi(*), 1aai(u0,u0),aa1(u0,u0),aad(u0,u0),aaf(u0,u0), 1aag(u0,u0),aah(u0,u0),aaii(u0,u0) real*8 ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28) common/spdfgh/nxig(15),nyig(15),nzig(15), 2nxih(21),nyih(21),nzih(21),nxii(28),nyii(28),nzii(28) c nxi(1)=0 nyi(1)=0 nzi(1)=0 do 83 i1=1,u0 do 83 i2=1,u0 83 aai(i1,i2)=aa1(i1,i2) if(shell.eq.'S')then npi=1 npii=1 cci(1)=ccs(ia,ip) return endif if(shell.eq.'P')then npi=3 npii=3 nxi(1)=1 nxi(2)=0 nyi(2)=1 nzi(2)=0 nxi(3)=0 nyi(3)=0 nzi(3)=1 cci(1)=ccp(ia,ip) cci(2)=ccp(ia,ip) cci(3)=ccp(ia,ip) return endif if(shell.eq.'L')then npi=4 npii=4 nxi(2)=1 nyi(2)=0 nzi(2)=0 nxi(3)=0 nyi(3)=1 nzi(3)=0 nxi(4)=0 nyi(4)=0 nzi(4)=1 cci(1)=ccs(ia,ip) cci(2)=ccp(ia,ip) cci(3)=ccp(ia,ip) cci(4)=ccp(ia,ip) return endif if(shell.eq.'D')then npi=6 npii=6 c order xx,yy,zz,xy,xz,yz nxi(1)=2 nxi(2)=0 nyi(2)=2 nzi(2)=0 nxi(3)=0 nyi(3)=0 nzi(3)=2 nxi(4)=1 nyi(4)=1 nzi(4)=0 nxi(5)=1 nyi(5)=0 nzi(5)=1 nxi(6)=0 nyi(6)=1 nzi(6)=1 cci(1)=ccd(ia,ip,1) cci(2)=ccd(ia,ip,1) cci(3)=ccd(ia,ip,1) cci(4)=ccd(ia,ip,2) cci(5)=ccd(ia,ip,2) cci(6)=ccd(ia,ip,2) if(ld5)then npii=5 do 78 i1=1,npii do 78 i2=1,npi 78 aai(i1,i2)=aad(i1,i2) endif return endif c SPD: if(shell.eq.'M')then npi=10 npii=10 nxi(2)=1 nyi(2)=0 nzi(2)=0 nxi(3)=0 nyi(3)=1 nzi(3)=0 nxi(4)=0 nyi(4)=0 nzi(4)=1 c order xx,yy,zz,xy,xz,yz nxi(5)=2 nyi(5)=0 nzi(5)=0 nxi(6)=0 nyi(6)=2 nzi(6)=0 nxi(7)=0 nyi(7)=0 nzi(7)=2 nxi(8)=1 nyi(8)=1 nzi(8)=0 nxi(9)=1 nyi(9)=0 nzi(9)=1 nxi(10)=0 nyi(10)=1 nzi(10)=1 cci(1)=ccs(ia,ip) cci(2)=ccp(ia,ip) cci(3)=ccp(ia,ip) cci(4)=ccp(ia,ip) cci(5)=ccd(ia,ip,1) cci(6)=ccd(ia,ip,1) cci(7)=ccd(ia,ip,1) cci(8)=ccd(ia,ip,2) cci(9)=ccd(ia,ip,2) cci(10)=ccd(ia,ip,2) if(ld5)then npii=9 aai=0.0d0 do 781 i1=1,4 781 aai(i1,i1)=1.0d0 do 782 i1=5,9 do 782 i2=5,10 782 aai(i1,i2)=aad(i1-4,i2-4) endif return endif if(shell.eq.'F')then npi=10 npii=10 c 1 2 3 4 5 6 7 8 9 10 c order xxx,yyy,zzz,xxy,xxz,yyx,yyz,zzx,zzy,xyz (cadpac) c xxx yyy zzz xyy xxy xxz xzz yzz yyz xyz (gaussian) c c use the cadpac order except for cartesian gaussian calculation: nxi(1)=3 nyi(1)=0 nzi(1)=0 nxi(2)=0 nyi(2)=3 nzi(2)=0 nxi(3)=0 nyi(3)=0 nzi(3)=3 if(.not.lf7)then nxi(4)=1 nyi(4)=2 nzi(4)=0 nxi(5)=2 nyi(5)=1 nzi(5)=0 nxi(6)=2 nyi(6)=0 nzi(6)=1 nxi(7)=1 nyi(7)=0 nzi(7)=2 nxi(8)=0 nyi(8)=1 nzi(8)=2 nxi(9)=0 nyi(9)=2 nzi(9)=1 else nxi(4)=2 nyi(4)=1 nzi(4)=0 nxi(5)=2 nyi(5)=0 nzi(5)=1 nxi(6)=1 nyi(6)=2 nzi(6)=0 nxi(7)=0 nyi(7)=2 nzi(7)=1 nxi(8)=1 nyi(8)=0 nzi(8)=2 nxi(9)=0 nyi(9)=1 nzi(9)=2 endif nxi(10)=1 nyi(10)=1 nzi(10)=1 cci(1)=ccf(ia,ip,1) cci(2)=ccf(ia,ip,1) cci(3)=ccf(ia,ip,1) cci(4)=ccf(ia,ip,2) cci(5)=ccf(ia,ip,2) cci(6)=ccf(ia,ip,2) cci(7)=ccf(ia,ip,2) cci(8)=ccf(ia,ip,2) cci(9)=ccf(ia,ip,2) cci(10)=ccf(ia,ip,3) if(lf7)then npii=7 do 79 i1=1,npii do 79 i2=1,npi 79 aai(i1,i2)=aaf(i1,i2) endif return endif if(shell.eq.'G')then npi=15 npii=15 do i1=1,npi nxi(i1)=nxig(i1) nyi(i1)=nyig(i1) nzi(i1)=nzig(i1) cci(i1) =cci_G(ia,ip,i1) enddo if(lg9)then npii=9 do 80 i1=1,npii do 80 i2=1,npi 80 aai(i1,i2)=aag(i1,i2) endif return endif if(shell.eq.'H')then npi=21 npii=21 do i1=1,npi nxi(i1)=nxih(i1) nyi(i1)=nyih(i1) nzi(i1)=nzih(i1) cci(i1) =cci_H(ia,ip,i1) enddo if(lh11)then npii=11 do 81 i1=1,npii do 81 i2=1,npi 81 aai(i1,i2)=aah(i1,i2) endif return endif if(shell.eq.'I')then npi=28 npii=28 do i1=1,npi nxi(i1)=nxii(i1) nyi(i1)=nyii(i1) nzi(i1)=nzii(i1) cci(i1) =cci_I(ia,ip,i1) enddo if(li13)then npii=13 do 82 i1=1,npii do 82 i2=1,npi 82 aai(i1,i2)=aaii(i1,i2) endif return endif write(6,*)'ia=',ia,' ip = ',ip,' shell = ',shell call report(' Unknown shell encountered') end function oi(m,ni,nj,ai,aj,xij,t,xi,xj) c c calculates integrals of the type c c infinity c / c | ni m nj -ai*(x-xi)^2 -aj*(x-xj)^2 c i= | (x-xi) x (x-xj) e e dx c | c / c -infinity c c i = sqrt(pi) * oi * exp(-ai*aj*xij^2/(ia+aj)) c c xij=(xj-xi); ai>0; aj>0 c implicit real*8 (a-h,o-z) implicit integer*4 (i-n) common/numbers/z0,one,two,three,four,five,half,a10 parameter (nd=24) common/poly/pp(nd,nd) c fac=one do 1 i=1,ni+nj+m+1 1 fac=fac*t c sum=z0 ci=aj*xij*t cj=-ai*xij*t cm=(ai*xi+aj*xj)*t do 2 l=0,ni pi=pp(ni+1,l+1) do 3 ll=1,ni-l 3 pi=pi*ci do 2 k=0,nj pj=pi*pp(nj+1,k+1) do 4 kk=1,nj-k 4 pj=pj*cj do 2 n=0,m pm=pj*pp(m+1,n+1) do 5 nn=1,m-n 5 pm=pm*cm 2 sum=sum+pm*ei(n+l+k) oi=fac*sum return end c function ei(N) implicit real*8 (a-h,o-z) implicit integer*4 (i-n) c infinity c / 2 c | N -y c i= | y e dy c | c / c -infinity c c i=sqrt(pi)*ei c common/numbers/z0,one,two,three,four,five,half,a10 c nt=N/2 if(nt+nt.ne.N)then ei=z0 return endif ho=-one zl=one do 1 i=1,nt ho=ho+two 1 zl=zl*ho*half ei=zl return end subroutine vz(a,n) real*8 a(*),z integer*4 i,n z=0.0d0 do 1 i=1,n 1 a(i)=z return end subroutine dimensions(n,fo,nmo,nmo2,nat,lzmat,lturbo,ltda,ncmm) c returns number of transitions and atoms implicit none integer*4 n,nat,l,I,q,nmo,nmo2,ncmm,it,nt,ie real*8 axdum character*80 s80 character*70 st character*(*) fo logical lzmat,lturbo,le,ltda n=0 nat=0 ncmm=0 it=0 c Grimme's TDA output - (CI soefficients from cicond) inquire(file='ciss_a.co',exist=ltda) if(ltda)then open(2,file='ciss_a.co') n=0 10 read(2,2000,end=790,err=790)s80 if(s80(1:1).eq.'e'.or.s80(1:2).eq.' ')then n=n+1 c nt: number of expansion coefficients for this state nt=0 11 read(2,2000,end=690,err=690)s80 if(s80(1:1).ne.'e'.and.s80(1:2).ne.' ')then nt=nt+1 goto 11 else backspace 2 endif 690 if(nt.gt.ncmm)then ncmm=nt it=n endif endif goto 10 790 close(2) write(6,*)n,' transitions in ciss_a.co' write(6,*)ncmm,' coefficients for state ',it endif c Turbomole output: inquire(file='control',exist=lturbo) if(lturbo)then write(6,*)'control file from Turbomole found ....' open(2,file='control') nmo=0 100 read(2,2000,end=990,err=990)s80 IF(s80(4:10).EQ.'natoms=')read(s80(11:len(s80)),*)nat IF(s80(4:11).EQ.'nbf(AO)=')read(s80(12:len(s80)),*)nmo if(nat.eq.0.or.nmo.eq.0)goto 100 990 close(2) if(nat.eq.0.or.nmo.eq.0)call report('nat nmo not determined') nmo2=nmo**2 write(6,*)' ..... and read' inquire(file='escf.out',exist=le) if(le)then write(6,*)'escf.out found' open(2,file='escf.out') 200 read(2,2000,end=991,err=991)s80 IF(s80(2:40).EQ.'total number of roots to be determined:')then read(s80(41:len(s80)),*)n goto 991 endif goto 200 991 close(2) if(n.eq.0)call report('n not determined') else call report('escf.out not found') endif return endif c Gaussian output: ie=0 open(2,file=fo) 1 read(2,2000,end=99,err=99)s80 2000 format(a80) IF((lzmat.and.(s80(19:39).EQ.'Z-Matrix orientation:'.OR. 1 s80(26:46).EQ.'Z-Matrix orientation:'.OR. 1 s80(20:37).EQ.'Input orientation:'.OR. 1 s80(27:44).EQ.'Input orientation:')) 1 .OR. 1 ((.not.lzmat).and. 2 (s80(20:40).EQ.'Standard orientation:'.OR. 2 s80(26:46).EQ.'Standard orientation:')))THEN write(6,2000)s80 DO 2004 I=1,4 2004 READ(2,*) l=0 2005 READ(2,2000)s80 IF(s80(2:4).NE.'---')THEN l=l+1 BACKSPACE 2 READ(2,*)q,q IF(q.EQ.-1)l=l-1 GOTO 2005 ENDIF nat=l ENDIF if(s80(31:49).eq.'primitive gaussians'.and.nmo.eq.0)then read(s80(1:6),*)nmo endif if(s80(2:44).eq.'Ground to excited state transition electric')then n=0 read(2,*) 3 read(2,3000,end=992,err=992)st 3000 format(10x,a70) read(st,*,end=992,err=992)axdum,axdum,axdum n=n+1 goto 3 992 write(6,*)n,' excited states' endif if(s80(2:15).eq.'Excited State ')then nt=0 ie=ie+1 77 read(2,2000)s80 do 7 i=1,50 7 if(s80(i:i+1).eq.'->'.or.s80(i:i+1).eq.'<-')nt=nt+1 if(s80(2:8).ne.'Excited'.and.s80(2:8).ne.' ')goto 77 backspace 2 if(nt.gt.ncmm)ncmm=nt write(6,607)ie,nt 607 format(' Excited State ',i4,',',i8,' coefficients') endif goto 1 99 close(2) nmo2=nmo**2 return end subroutine rdtm(qz,x,bohr,xau,na,nb,nmo2,n,nmo, 1dl,r,r0v,r0l,e,ev,eau,ni,nid,nat,cij,lopen, 1aij,bij,ifix,nib,cijb,aijb,bijb,lnorm,lort,lwrt) implicit none character*80 s80 logical lopen,lnorm,lort,lwrt integer*4 I,l,qz(*),na,nb,nmo2,n,k,ie,ni(*),ic,kk, 1nid(*),nat,aij(*),bij(*),j,oa,ob,jj,ii,icc,it, 1ifix,nib(*),aijb(*),bijb(*),amax,bmax,nmo,nort,imax, 1ichek(100),nex,nf0,i1,i2,i3 parameter (nf0=64) integer*4 ifrom(nf0),ito(nf0),nff,iac,ns,nmosy(nf0), 1noccsy(nf0),ofrom(nf0),oto(nf0),syt(nf0,nf0),svec(nf0) logical lff character*50 ffn(nf0) character*1 abmax real*8 x(3,nat),xau(3,nat),dl(n,3), 1r(n,3),r0v(*),r0l(*),e(*),ev(*),eau(*),cij(*), 1cijb(*),cmax,skj,sum1,sum2,bohr real*8,allocatable::obaj(:),obak(:) real*8 ska do 3 i=1,100 3 ichek(i)=0 write(6,*)'re-reading escf.out' n=0 open(2,file='escf.out') 2001 read(2,2000,end=23,err=23)s80 2000 format(a80) if(s80(15:32).EQ.'atomic coordinates')then do 1001 l=1,nat read(2,2000,end=23,err=23)s80 read(s80(1:43),*)(xau(i,l),i=1,3) x(1,l)=xau(1,l)*bohr x(2,l)=xau(2,l)*bohr x(3,l)=xau(3,l)*bohr 1001 read(s80(58:60),*)qz(l) ichek(1)=1 endif if(s80(2:30).EQ.'number of occupied orbitals :')then read(s80(31:len(s80)),*)na nb=na ichek(2)=1 endif if(s80(2:24).EQ.'Excitation energy: ')then n=n+1 read(s80(25:len(s80)),*)eau(n) ichek(3)=1 endif if(s80(2:24).EQ.'Excitation energy / eV:')then read(s80(25:len(s80)),*)ev(n) ichek(4)=1 endif if(s80(2:24).EQ.'Excitation energy / nm:')then read(s80(25:len(s80)),*)e(n) ichek(5)=1 endif if(s80(2:39).eq.'Electric transition dipole moment (vel')then ichek(6)=1 endif if(s80(2:39).eq.'Electric transition dipole moment (len')then read(2,*) read(2,2009)dl(n,1) read(2,2009)dl(n,2) read(2,2009)dl(n,3) ichek(7)=1 endif if(s80(2:34).eq.'Magnetic transition dipole moment')then read(2,*) read(2,2009)r(n,1) read(2,2009)r(n,2) read(2,2009)r(n,3) 2009 format(5x,f16.6) ichek(8)=1 endif if(s80(2:31).eq.'Electric quadrupole transition')then read(2,*) ichek(9)=1 endif if(s80(2:19).eq.'Rotatory strength:')then read(2,2000,end=23,err=23)s80 read(2,2000,end=23,err=23)s80 read(s80(39:len(s80)),*)r0v(n) read(2,2000,end=23,err=23)s80 read(2,2000,end=23,err=23)s80 read(2,2000,end=23,err=23)s80 read(2,2000,end=23,err=23)s80 read(s80(39:len(s80)),*)r0l(n) ichek(10)=1 endif if(s80(11:40).eq.'IRREP tensor space dimension')then nff=0 iac=0 read(2,*) 944 read(2,2000)s80 if(s80(11:13).ne.' ')then nff=nff+1 if(nff.gt.nf0)call report('nff.gt.nf0') read(s80(20:30),*)ii ifrom(nff)=iac+1 ito(nff)=iac+ii write(6,*)'symmetry',nff,' from state ', 1 ifrom(nff),' to ',ito(nff) iac=iac+ii goto 944 endif ichek(11)=1 endif if(s80(4:13).eq.'irrep mo')then nff=0 iac=0 945 read(2,2000)s80 if(s80(3:8).ne.' ')then nff=nff+1 if(nff.gt.nf0)call report('nff.gt.nf0') read(s80(8:len(s80)),*)ii,noccsy(nff) nmosy(nff)=ii ofrom(nff)=iac+1 oto(nff)=iac+ii write(6,*)'symmetry',nff,' from MO ',iac+1,' to ',oto(nff), 1 ' occ:',noccsy(nff) iac=iac+ii goto 945 endif ichek(12)=1 endif goto 2001 23 close(2) write(6,*)n,' excitations from escf.out' if(ichek( 1).eq.0)call report(' Atomic coordinates missing') if(ichek( 2).eq.0)call report(' Nocc missing') if(ichek( 3).eq.0)call report(' E missing') if(ichek( 4).eq.0)call report(' E-eV missing') if(ichek( 5).eq.0)call report(' E-nm missing') if(ichek( 6).eq.0)call report(' Dipole-v missing') if(ichek( 7).eq.0)call report(' Dipole-l missing') if(ichek( 8).eq.0)call report(' Magnet missing') if(ichek( 9).eq.0)call report(' Quadrupole missing') if(ichek(10).eq.0)call report(' Rotatory strength missing') if(ichek(11).eq.0)call report(' Number of symmetries missing') if(ichek(12).eq.0)call report(' Orbital symmetries missing') if(nff.ne.1)then open(2,file='sym',status='old') read(2,*)ie if(ie.ne.nff)call report('ie<>nff') do 556 i=1,nff 556 read(2,*)(syt(i,j),j=1,nff) write(6,*)'sym with symmetry table found' else syt(1,1)=1 endif ie=0 lopen=.false. inquire(file='F.LST',exist=lff) if(lff)then open(8,file='F.LST') do 800 i=1,nff 800 read(8,8000)ffn(i) 8000 format(a50) else if(nff.ne.1)call report('F.LST missing') ffn(1)='sing_a' ifrom(1)=1 ito(1)=nmo endif it=0 do 555 ic=1,nff write(6,*)'reading '//ffn(ic) open(2,file=ffn(ic),status='old') 1 read(2,2000,end=2,err=2)s80 if(s80(2:27).eq.'current subspace dimension') 1read(s80(28:36),*)ns if(s80(13:24).eq.'eigenvalue =')then write(6,2000)s80 read(s80(1:9),*)ie it=it+1 write(6,*)' total eigenvalue ',it ii=0 c occupied symmetries do 557 i1=1,nff c virtual symmetries do 557 i2=1,nff c does is give symmetry ic?: do 558 i3=1,nff 558 svec(i3)=syt(i1,i3)*syt(i2,i3) if(ie.eq.1)write(6,*)i1,i2,(svec(i3),i3=1,nff) icc=0 do 559 i3=1,nff do 5591 jj=1,nff 5591 if(syt(i3,jj).ne.svec(jj))goto 559 icc=i3 559 continue if(icc.eq.0)call report('symmetry calc. error') if(ie.eq.1)write(6,*)i1,'x',i2,'corresponds to ',icc,' want',ic if(icc.eq.ic)then do 300 i=ofrom(i1),ofrom(i1)+noccsy(i1)-1 do 300 j=ofrom(i2)+noccsy(i2),ofrom(i2)+nmosy(i2)-1 ii=ii+1 aij( nmo2*(it-1)+ii)=i aijb(nmo2*(it-1)+ii)=i bijb(nmo2*(it-1)+ii)=j if(j.gt.nmo.or.i.gt.nmo)then write(6,*)i1,i2,i,j,ofrom(i2),noccsy(i2),nmosy(i2) call report('overflow2') endif 300 bij( nmo2*(it-1)+ii)=j endif 557 continue if(ie.eq.1)write(6,*)ii,' states determined from orbitals' ni(it)=ns if(ii.ne.ns)then write(6,*)ic,ie,it,ni(ie),ns,noccsy(ic),nmosy(ic) call report('incosistent numbering') endif nib(it)=ni(it) nid(it)=0 cmax=0.0d0 amax=0 bmax=0 imax=0 sum1=0.0d0 sum2=0.0d0 read(2,900)(cij(nmo2*(it-1)+ii),ii=1,ni(it)), 1 (cijb(nmo2*(it-1)+ii),ii=1,nib(it)) 900 format(4d20.14) nex=0 do 301 ii=1,ni(it) call setabmax(aij(nmo2*(it-1)+ii),bij(nmo2*(it-1)+ii), 1 cij(nmo2*(it-1)+ii),amax,bmax,cmax,ii,imax,abmax,' ') sum1=sum1+cij(nmo2*(it-1)+ii)**2 sum2=sum2+cijb(nmo2*(it-1)+ii)**2 c experimental fix for the deexitations, closed shell only: if(ifix.eq.1) 1 cij(nmo2*(it-1)+ii)=cij(nmo2*(it-1)+ii)+cijb(nmo2*(it-1)+ii) c experimental fix,just add to excitations with switched orbitals: if(ifix.eq.3)then nex=nex+1 cij(nmo2*(it-1)+ni(it)+nex)=cijb(nmo2*(it-1)+ii) aij(nmo2*(it-1)+ni(it)+nex)=bijb(nmo2*(it-1)+ii) bij(nmo2*(it-1)+ni(it)+nex)=aijb(nmo2*(it-1)+ii) nib(it)=0 endif 301 continue ni(it)=ni(it)+nex if(lwrt)then write(6,*)ni(it),' alpha coefficitnts' if(ifix.eq.3)write(6,*)'(with backwards)' write(6,*)nid(it),' beta coefficitnts' write(6,*)nib(it),' backward coefficitnts' write(6,6009)amax,bmax,cij(nmo2*(it-1)+imax),cmax**2*100.0d0 6009 format(' Dominant transition from',i4,' to ',i4,f8.3, 1 ' (',f6.2,' %)') if(.not.lopen)write(6,1234)sum1,sum2 1234 format('fnorm, bnorm:',2f10.4) endif if(ifix.eq.4.and.lwrt)then nib(it)=0 write(6,*)'backward ignored' endif c seems that fnorm-bnorm=1 endif goto 1 c 2 close(2) 555 continue if(lnorm)then c renormalize: call normcij(it,cij,ni,nmo2) write(6,*)' cij were normalized' endif if(lort)then nort=n if(lwrt)then do i=1,n write(6,6000)i,e(i) 6000 format(' state ',i4,f12.5) do ii=1,ni(i) j=nmo2*(i-1) if(dabs(cij(j+ii)).gt.0.1d0) 1 write(6,6001)aij(j+ii),bij(j+ii),cij(j+ii) 6001 format(2i4,f12.6) enddo enddo endif c reorthonormalize: write(6,*)'orthogonalizing coefficients for ',nort,' states' if(lopen)call report('lort for open shell not implemented') allocate(obaj(nmo2),obak(nmo2)) c run twice for better accuracy: do 318 ic=1,2 ska=0.0d0 do 3181 j=1,nort c transcript original cij to obaj: do 320 jj=1,nmo2 320 obaj(jj)=0.0d0 do 324 jj=1,ni(j) oa=aij(nmo2*(j-1)+jj) ob=bij(nmo2*(j-1)+jj) if(ob+nmo*(oa-1).gt.nmo2)then write(6,*)oa,ob,nmo2 call report('overflow') endif 324 obaj(ob+nmo*(oa-1))=cij(nmo2*(j-1)+jj) do 319 k=1,j-1 c transcript cij to obak: do 321 kk=1,nmo2 321 obak(kk)=0.0d0 kk=nmo2*(k-1) do 3241 jj=1,ni(k) oa=aij(kk+jj) ob=bij(kk+jj) 3241 obak(ob+nmo*(oa-1))=cij(kk+jj) c : skj=0.0d0 do 322 oa=1,na do 322 ob=na+1,nmo c forward excitations: skj=skj+obaj(ob+nmo*(oa-1))*obak(ob+nmo*(oa-1)) c backward excitations: 322 skj=skj+obaj(oa+nmo*(ob-1))*obak(oa+nmo*(ob-1)) c |j'>=|j>-|k>: do 319 oa=1,na do 319 ob=na+1,nmo obaj(ob+nmo*(oa-1))=obaj(ob+nmo*(oa-1))-skj*obak(ob+nmo*(oa-1)) 319 obaj(oa+nmo*(ob-1))=obaj(oa+nmo*(ob-1))-skj*obak(oa+nmo*(ob-1)) ska=ska+dabs(skj) c c transcript new obaj to new cij: ni(j)=0 do 325 oa=1,na do 325 ob=na+1,nmo jj=ob+nmo*(oa-1) if(obaj(jj).ne.0.0d0)then ni(j)=ni(j)+1 cij(nmo2*(j-1)+ni(j))=obaj(jj) aij(nmo2*(j-1)+ni(j))=oa bij(nmo2*(j-1)+ni(j))=ob endif jj=oa+nmo*(ob-1) if(obaj(jj).ne.0.0d0)then ni(j)=ni(j)+1 cij(nmo2*(j-1)+ni(j))=obaj(jj) aij(nmo2*(j-1)+ni(j))=ob bij(nmo2*(j-1)+ni(j))=oa endif 325 continue 3181 call normcij(j,cij,ni,nmo2) write(6,*)ic,ska/dble(nort**2)/2.0d0 318 continue write(6,*)'double orthogonalization done' deallocate(obaj,obak) endif return end subroutine readfile(lzmat,qz,x,bohr,xau,na,nb,n22,n, 1dl,r,r0v,r0l,e,ev,eau,ni,lden,nid,nat,cij,lopen, 1aij,bij,dij,daij,dbij,fo,nib,lwrt, 1nibd,ltda,loniom,io1,io2) implicit none character*80 s80 character*75 st character*(*) fo logical lzmat,lden,lopen,lwrt,ltda,loniom integer*4 ig98,I,l,qz(*),na,nb,n22,n,nd,k,ie,ni(*), 1nid(*),nat,aij(*),bij(*),dbij(*),daij(*),j,qzt, 1nib(*),amax,bmax,io1,io2, 1nibd(*),imax,ii,natt real*8 x(3,nat),bohr,xau(3,nat),dl(n,3), 1r(n,3),r0v(*),r0l(*),e(*),ev(*),eau(*),cij(*),dij(*),tq, 1ax,ay,az,cmax,sum1,sum2,xt,yt,zt integer*4,allocatable::ipse(:) character*1 abmax nat=0 ie=0 lopen=.false. tq=dsqrt(2.0d0) open(2,file=fo) 1 read(2,2000,end=2,err=2)s80 2000 format(a80) IF((lzmat.and.(s80(19:39).EQ.'Z-Matrix orientation:'.OR. 1 s80(26:46).EQ.'Z-Matrix orientation:'.OR. 1 s80(20:37).EQ.'Input orientation:'.OR. 1 s80(27:44).EQ.'Input orientation:')) 1 .OR. 1 ((.not.lzmat).and. 2 (s80(20:40).EQ.'Standard orientation:'.OR. 2 s80(26:46).EQ.'Standard orientation:')))THEN ig98=0 if(s80(26:46).EQ.'Z-Matrix orientation:'.OR. 1 s80(27:44).EQ.'Input orientation:'.OR. 1 s80(26:46).EQ.'Standard orientation:')ig98=1 write(6,2000)s80 DO 2004 I=1,4 2004 READ(2,*) l=0 j=0 2005 READ(2,2000)s80 IF(s80(2:4).NE.'---')THEN l=l+1 BACKSPACE 2 if(ig98.eq.0)then READ(2,*)qzt,qzt, xt,yt,zt else READ(2,*)qzt,qzt,xt,xt,yt,zt endif IF(qzt.EQ.-1)l=l-1 if(.not.loniom.or.(l.ge.io1.and.l.le.io2))then j=j+1 qz(j)=qzt x(1,j)=xt x(2,j)=yt x(3,j)=zt xau(1,j)=xt/bohr xau(2,j)=yt/bohr xau(3,j)=zt/bohr endif GOTO 2005 ENDIF natt=l nat=j ENDIF if(s80(40:50).eq.'Pseudopoten')then allocate(ipse(natt)) call rdps(natt,ipse) j=0 do 335 i=1,natt if(.not.loniom.or.(l.ge.io1.and.l.le.io2))then j=j+1 if(ipse(i).ne.0)then write(6,6885)i,ipse(i) 6885 format(' atom ',i4,' atomic charge reduced to',i4) qz(j)=ipse(i) endif endif 335 continue endif if(s80(8:22).eq.'alpha electrons')then read(s80( 1: 6),*)na read(s80(25:31),*)nb write(6,2000)s80 if(ltda)then write(6,*)'leaving readfile because of tda' close(2) return endif endif if(s80(2:44).eq.'Ground to excited state transition electric')then n=0 write(6,2000)s80 read(2,*) 3 read(2,3000,end=21,err=21)st 3000 format(10x,a75) read(st,*,end=21,err=21)ax,ay,az n=n+1 dl(n,1)=ax dl(n,2)=ay dl(n,3)=az goto 3 21 backspace 2 write(6,*)n,' dipole length transitions' endif if(s80(2:51).eq. 1'Ground to excited state transition velocity dipole')then write(6,2000)s80 read(2,*) write(6,*)n,' dipole velocity transitions skipped' endif c if(s80(2:44).eq.'Ground to excited state transition magnetic')then write(6,2000)s80 read(2,*) do 10 i=1,n read(2,3000)st 10 read(st,*)(r(i,j),j=1,3) write(6,*)n,' magnetic transitions' endif if(s80(2:55).eq. 1'Ground to excited state transition velocity quadrupole')then write(6,2000)s80 read(2,*) write(6,*)n,' quadrupole velocity transitions skipped' endif c if(s80(53:63).eq.'R(velocity)') then write(6,2000)s80 c Gaussian 98 does not write R(length) nor R(velocity) do 8 i=1,n read(2,3000)st read(st,*,err=99)r0v(i),r0v(i),r0v(i),r0v(i) goto 991 99 write(6,3000)st write(6,*)i stop 991 continue read(2,2000)s80 if(s80(2:6).eq.'Total')then do 81 k=1,4 81 read(2,2000)s80 else backspace 2 endif read(2,2000)s80 if(s80(2:3).eq.'R(')then do 82 k=1,4 82 read(2,2000)s80 else backspace 2 endif 8 continue endif if(s80(54:62).eq.'R(length)') then write(6,2000)s80 do 11 i=1,n read(2,3000)st 11 read(st,*,end=2,err=2)r0l(i),r0l(i),r0l(i),r0l(i) endif c if(s80(2:15).eq.'Excited State '.and.s80(16:16).ne.'s')then do 203 i=1,79 if(s80(i:i).eq.':')read(s80(15:i-1),*)nd if(s80(i:i+1).eq.'eV')read(s80(i-10:i-2),*)ev(nd) 203 if(s80(i:i+1).eq.'nm')read(s80(i- 9:i-2),*)e(nd) c ecm(i)=ev(i)*8065.54476345045d0 eau(nd)=ev(nd)/27.211384205943d0 ie=ie+1 if(ie.ne.nd)call report(' Inconsistent reading') cmax=0.0d0 amax=0 bmax=0 imax=0 abmax='x' if(lden)then ni(ie)=0 nib(ie)=0 nibd(ie)=0 nid(ie)=0 sum1=0.0d0 sum2=0.0d0 111 read(2,2000,end=299,err=299)s80 if(s80(10:11).eq.'->')then if(ni(ie).gt.n22)call report('too many coefficients') if(s80(8:8).eq.'A')then c open shell, alpha: lopen=.true. ni(ie)=ni(ie)+1 ii=n22*(ie-1)+ni(ie) read(s80( 1: 7),*)aij(ii) if(s80(15:15).eq.'A')then read(s80(12:14),*)bij(ii) else if(s80(16:16).eq.'A')then read(s80(12:15),*)bij(ii) else write(6,2000)s80 call report('Unknown format of excitations') endif endif read(s80(18:30),*)cij(ii) call setabmax(aij(ii),bij(ii),cij(ii), 2 amax,bmax,cmax,ii,imax,abmax,'A') sum1=sum1+cij(ii)**2 else if(s80(8:8).eq.'B')then c open shell, beta: nid(ie)=nid(ie)+1 ii=n22*(ie-1)+nid(ie) lopen=.true. read(s80( 1: 7),*)daij(ii) if(s80(15:15).eq.'B')then read(s80(12:14),*)dbij(ii) else if(s80(16:16).eq.'B')then read(s80(12:15),*)dbij(ii) else write(6,2000)s80 call report('Unknown format of excitations') endif endif read(s80(18:30),*) dij(ii) call setabmax(daij(ii),dbij(ii),dij(ii), 2 amax,bmax,cmax,ii,imax,abmax,'B') sum1=sum1+dij(ii)**2 else c closed shell: ni(ie)=ni(ie)+1 ii=n22*(ie-1)+ni(ie) read(s80( 1: 8),*) aij(ii) read(s80(12:15),*) bij(ii) read(s80(18:30),*) cij(ii) cij(ii)=cij(ii)*tq call setabmax(aij(ii),bij(ii),cij(ii), 2 amax,bmax,cmax,ii,imax,abmax,' ') sum1=sum1+cij(ii)**2 endif endif goto 111 endif 299 continue if(lwrt)then write(6,*)ni(ie),' alpha coefficients' write(6,*)nid(ie),' beta coefficients' write(6,*)nib(ie),' backward coefficients' if(abmax.eq.'B')then write(6,6009)ie,amax,'B',bmax,'B',dij(imax),cmax**2*100.0d0 6009 format(i5,': Dominant transition from',i4,a1,' to ',i4,a1, 1 f8.3,' (',f6.2,' %)') else if(abmax.eq.'A')then write(6,6009)ie,amax,'A',bmax,'A',cij(imax),cmax**2*100.0d0 else write(6,6009)ie,amax,' ',bmax,' ',cij(imax),cmax**2*100.0d0 endif endif write(6,1234)sum1,sum2,sum1-sum2 1234 format('fnorm, bnorm,diff:',3f10.4) endif endif if(nd.eq.n) goto 2 endif goto 1 c 2 close(2) return end subroutine readtda(na,nb,nmo2,n,nmo,e,ev,eau,ni,lden,nid,cij, 1lopen,aij,bij,dij,daij,dbij,ifix,nib,lnorm,lort,lwrt,nibd,ncmm) implicit none character*80 s80 logical lden,lopen,lnorm,lort,lwrt integer*4 na,nb,nmo2,n,nd,k,ie,ni(*),ic,kk,nid(*),aij(*),bij(*), 1dbij(*),daij(*),j,oa,ob,jj,ifix,nib(*),amax,bmax,nmo,nort, 1nibd(*),ii,n22,ncmm,imax real*8 e(*),ev(*),eau(*),cij(*),dij(*),cmax,skj,sum1,sum2,ecm,ska real*8,allocatable::obaj(:),obak(:),obajd(:),obakd(:) character*1 abmax if(ncmm.ne.0)then n22=ncmm else n22=nmo2 endif ie=0 lopen=.false. open(2,file='ciss_a.co') 1 read(2,2000,end=2,err=2)s80 write(6,2000)s80 2000 format(a80) c if(s80(1:1).eq.'e'.or.s80(1:2).eq.' ')then ie=ie+1 read(s80(3:len(s80)),*)nd,eau(nd) ev(nd)=eau(nd)*27.211384205943d0 ecm=ev(nd)*8065.54476345045d0 e(nd)=1.0d7/ecm if(ie.ne.nd)call report(' Inconsistent reading') cmax=0.0d0 amax=0 bmax=0 imax=0 if(lden)then ni(ie)=0 nib(ie)=0 nibd(ie)=0 nid(ie)=0 sum1=0.0d0 sum2=0.0d0 111 read(2,2000,end=299,err=299)s80 if(s80(1:1).ne.'e'.and.s80(1:2).ne.' ')then if(ni(ie).gt.n22)call report('too many coefficients') c closed shell: ni(ie)=ni(ie)+1 ii=n22*(ie-1)+ni(ie) read(s80,*)cij(ii),aij(ii),bij(ii) call setabmax(aij(ii),bij(ii),cij(ii),amax,bmax,cmax, 1 ii,imax,abmax,' ') sum1=sum1+cij(ii)**2 goto 111 else backspace 2 endif 299 continue if(lwrt)then write(6,*)ni(ie),' alpha coefficients' if(ifix.eq.3)write(6,*)'(with backwards)' write(6,*)nid(ie),' beta coefficients' write(6,*)nib(ie),' backward coefficients' write(6,6009)amax,bmax,cij(imax),cmax**2*100.0d0 6009 format(' Dominant transition from',i4,' to ',i4,2f8.3) write(6,1234)sum1,sum2,sum1-sum2 1234 format('fnorm, bnorm,diff:',3f10.4) endif if(lnorm)then c renormalize: call normcijo(ie,cij,dij,ni,nid,n22,lopen) write(6,*)' cij were normalized' endif endif if(nd.eq.n) goto 2 endif goto 1 c 2 close(2) if(lort)then if(nmo2.ne.n22)call report('cannot re-orthogonalize' 1 //'within limited coefficient space') nort=n c reorthonormalize: write(6,*)'orthogonalizing coefficients for ',nort,' states' allocate(obaj(nmo2),obak(nmo2)) if(lopen)allocate(obajd(nmo2),obakd(nmo2)) write(6,*)'temporary variables allocated' c run twice for better accuracy: do 318 ic=1,2 ska=0.0d0 do 3181 j=1,nort c transcript original cij to obaj: call vz(obaj,nmo2) do 324 jj=1,ni(j) oa=aij(n22*(j-1)+jj) ob=bij(n22*(j-1)+jj) 324 obaj(ob+nmo*(oa-1))=cij(n22*(j-1)+jj) if(lopen)then call vz(obajd,nmo2) do 3241 jj=1,nid(j) oa=daij(n22*(j-1)+jj) ob=dbij(n22*(j-1)+jj) 3241 obajd(ob+nmo*(oa-1))=dij(n22*(j-1)+jj) endif do 334 k=1,j-1 c transcript cij to obak: call vz(obak,nmo2) kk=n22*(k-1) do 3242 jj=1,ni(k) oa=aij(kk+jj) ob=bij(kk+jj) 3242 obak(ob+nmo*(oa-1))=cij(kk+jj) if(lopen)then call vz(obakd,nmo2) kk=n22*(k-1) do 3243 jj=1,nid(k) oa=daij(kk+jj) ob=dbij(kk+jj) 3243 obakd(ob+nmo*(oa-1))=dij(kk+jj) endif c : skj=0.0d0 do 323 oa=1,na do 323 ob=na+1,nmo c forward excitations: skj=skj+obaj(ob+nmo*(oa-1))*obak(ob+nmo*(oa-1)) c backward excitations: 323 skj=skj+obaj(oa+nmo*(ob-1))*obak(oa+nmo*(ob-1)) if(lopen)then do 331 oa=1,nb do 331 ob=nb+1,nmo skj=skj+obajd(ob+nmo*(oa-1))*obakd(ob+nmo*(oa-1)) 331 skj=skj+obajd(oa+nmo*(ob-1))*obakd(oa+nmo*(ob-1)) endif c |j'>=|j>-|k>: do 319 oa=1,na do 319 ob=na+1,nmo if(oa+nmo*(ob-1).gt.nmo2)write(6,*)'A',oa,ob,nmo2 if(ob+nmo*(oa-1).gt.nmo2)write(6,*)'B',oa,ob,nmo2 obaj(ob+nmo*(oa-1))=obaj(ob+nmo*(oa-1))-skj*obak(ob+nmo*(oa-1)) 319 obaj(oa+nmo*(ob-1))=obaj(oa+nmo*(ob-1))-skj*obak(oa+nmo*(ob-1)) if(lopen)then do 332 oa=1,nb do 332 ob=nb+1,nmo obajd(ob+nmo*(oa-1))= 1 obajd(ob+nmo*(oa-1))-skj*obakd(ob+nmo*(oa-1)) 332 obajd(oa+nmo*(ob-1))= 1 obajd(oa+nmo*(ob-1))-skj*obakd(oa+nmo*(ob-1)) endif 334 ska=ska+dabs(skj) c c transcript new obaj to new cij: if(lopen)then nid(j)=0 do 333 oa=1,nb do 333 ob=nb+1,nmo jj=ob+nmo*(oa-1) if(obajd(jj).ne.0.0d0)then nid(j)=nid(j)+1 dij( n22*(j-1)+nid(j))=obajd(jj) daij(n22*(j-1)+nid(j))=oa dbij(n22*(j-1)+nid(j))=ob endif jj=oa+nmo*(ob-1) if(obajd(jj).ne.0.0d0)then nid(j)=nid(j)+1 dij( n22*(j-1)+nid(j))=obajd(jj) daij(n22*(j-1)+nid(j))=ob dbij(n22*(j-1)+nid(j))=oa endif 333 continue endif ni(j)=0 do 325 oa=1,na do 325 ob=na+1,nmo jj=ob+nmo*(oa-1) if(obaj(jj).ne.0.0d0)then ni(j)=ni(j)+1 cij(n22*(j-1)+ni(j))=obaj(jj) aij(n22*(j-1)+ni(j))=oa bij(n22*(j-1)+ni(j))=ob endif jj=oa+nmo*(ob-1) if(obaj(jj).ne.0.0d0)then ni(j)=ni(j)+1 cij(n22*(j-1)+ni(j))=obaj(jj) aij(n22*(j-1)+ni(j))=ob bij(n22*(j-1)+ni(j))=oa endif 325 continue 3181 call normcijo(j,cij,dij,ni,nid,n22,lopen) write(6,*)ic,ska/dble(nort**2)/2.0d0 318 continue write(6,*)'double orthogonalization done' endif return end subroutine normcijo(ie,cij,dij,ni,nid,nmo2,lopen) implicit none real*8 anorm,cij(*),dij(*) integer*4 j,ni(*),ie,nmo2,nid(*) logical lopen anorm=0.0d0 do 315 j=1,ni(ie) 315 anorm=anorm+cij(nmo2*(ie-1)+j)**2 if(lopen)then do 316 j=1,nid(ie) 316 anorm=anorm+dij(nmo2*(ie-1)+j)**2 endif anorm=1.0d0/dsqrt(anorm) do 317 j=1,ni(ie) 317 cij(nmo2*(ie-1)+j)=cij(nmo2*(ie-1)+j)*anorm if(lopen)then do 318 j=1,nid(ie) 318 dij(nmo2*(ie-1)+j)=dij(nmo2*(ie-1)+j)*anorm endif return end subroutine setv(eau,w,fr,fi,g,gnm,lgnm,lgau) implicit none real*8 w,jm,fr,fi,g,wau,eau,gnm,a,pi,ln2,ff logical lgnm,lgau c nm to au:= c wau=(1.0d7/w)/219474.63d0 wau=45.5633528d0/w c set bandwidth, either constant in wavelength or energy: if(lgnm)then if(w.gt.gnm)then a=45.5633528d0*gnm/(w-gnm)/(w+gnm) else a=gnm*wau/w endif else a=g endif ff= (eau-wau)*(eau+wau) jm= ff**2+(a*eau)**2 fr= ff / jm if(lgau)then c Gaussian curve for dispersion pi=4.0d0*datan(1.0d0) ln2=log(2.0d0) if(dabs(eau-wau).gt.5.0d0*a)then fi=0.0d0 else fi=dsqrt(pi*ln2)/a/eau**2*exp(-4.0d0*ln2*((eau-wau)/a)**2) endif else c Lorentzian curve G /[(w^2-w0^2)^2 + G^2 w0^2] fi= a / jm endif fr=fr+fr fi=fi+fi return end subroutine normcij(ie,cij,ni,nmo2) implicit none real*8 anorm,cij(*) integer*4 j,ni(*),ie,nmo2 anorm=0.0d0 do 316 j=1,ni(ie) 316 anorm=anorm+cij(nmo2*(ie-1)+j)**2 anorm=1.0d0/dsqrt(anorm) do 317 j=1,ni(ie) 317 cij(nmo2*(ie-1)+j)=cij(nmo2*(ie-1)+j)*anorm return end subroutine setabmax(a,b,c,amax,bmax,cmax,n,i,abmax,ab) implicit none integer*4 a,b,amax,bmax,n,i real*8 c,cmax character*1 abmax,ab if(dabs(c).gt.cmax)then cmax=dabs(c) amax=a bmax=b i=n abmax=ab endif return end c subroutine inibe4 implicit real*8 (a-h,o-z) implicit integer*4 (i-n) parameter (n5=5,nX=2000,mmax=21) common/ap4/et(nX),ei(mmax,nX),dt(mmax),dt63(mmax),dt62(mmax), 1ti(mmax),t5(mmax),dtt,t23,dtt2,dtt3 logical lbe a8=8.0d0 four=4.0d0 one=1.0d0 pi=4.0d0*datan(1.0d0) qua=0.25d0 six=6.0d0 two=2.0d0 z0=0.0d0 c inquire(file='BE4.SCR',exist=lbe) if(lbe)then open(23,file='BE4.SCR',FORM='unformatted') read(23)nxtr,et,ei,dt,dt63,dt62,ti,t5,dtt,t23,dtt2,dtt3 close(23) if(nxtr.ne.nX)goto 9000 return endif c 9000 an5=dble(n5) spi=sqrt(pi) c c Loop over functions: do 6 m=0,mmax-1 am=dble(m) c c pre-calculate inflection points: c calculate ti, when inflection point is for u=1: ti(m+1)=(four*am+one+sqrt(two*a8*am+one))*qua c last point t5(m+1)=an5*an5*ti(m+1) c c amm=(2m-1)!! amm=one ad=one 30 amm=amm*ad ad=ad+two if(ad.lt.two*am)goto 30 c tmp=one do 43 ii=1,m+1 43 tmp=tmp*two c c elementary interval dt(m+1)=t5(m+1)/dble(nX) dt63(m+1)=one/(six*dt(m+1)*dt(m+1)*dt(m+1)) dt62(m+1)=one/(two*dt(m+1)*dt(m+1)) c c values at the first and last points ei(m+1,1)=one/(one+two*am)*sqrt(two/pi) ei(m+1,nX)=amm/sqrt(two*(t5(m+1)-dt(m+1)))**(2*m+1) c c values in the middle t=z0 stpi=sqrt(two/pi) do 6 i=2,nX-1 t=t+dt(m+1) c sum=z0 do 20 l=1,m al=dble(l) c c all=(2l-1)!! all=one ad=one 10 all=all*ad ad=ad+two if(ad.lt.two*al)goto 10 c c tl=2^l ttl=t^(l-1) tl=one ttl=one do 40 ii=1,l 40 tl=tl*two do 41 ii=1,l-1 41 ttl=ttl*t 20 sum=sum+ttl*tl / all st=sqrt(t) tm=one do 42 ii=1,m 42 tm=tm*t 6 ei(m+1,i)=amm*(spi*erfcacm(st)-exp(-t)*st*sum)/(tmp*tm*st)*stpi c Error function 4 initialized c c initialize exp(-x) c elementary interval t23=dble(26) dtt=t23/dble(nX) dtt3=one/(six*dtt*dtt*dtt) dtt2=one/(two*dtt*dtt) t=-dtt do 44 i=1,nX t=t+dtt 44 et(i)=exp(-t) c exp(-t) initialized open(23,file='BE4.SCR',FORM='unformatted') write(23)nX,et,ei,dt,dt63,dt62,ti,t5,dtt,t23,dtt2,dtt3 close(23) return end function erfcacm(q) c c error function from collected algorithms from CACM, alg. # 123 c c erfcacm(x)=(2/sqrt(pi))integral(0..x)exp(-t^2)dt real*8 erfcacm,q,x, a,u,v,w,y,z,t, n,pi,pic pi=4.0d0*datan(1.0d0) pic=2.0D0/sqrt(pi) x=q z=0.0D0 1 if(dabs(x).gt.1.0D-20)then if(0.5D0.lt.abs(x))then a=-sign(0.5D0,x) else a=-x endif u=pic*exp(-x*x) v=u t=-v*a y=t n=1.0D0 2 if(abs(t).ge.1.0D-20)then n=n+1.0D0 w=-2.0D0*(x*v+(n-2.0D0)*u) t=t*w*a/(v*n) u=v v=w y=y+t goto 2 endif z=z+y x=x+a goto 1 endif erfcacm=z return end subroutine forb(orb,rx,ry,rz,ty,nao,nat,xv,nop,alpha,ish,nlim, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13) c orb .. orbital values in point rx ry rz implicit none integer*4 nor,u0 parameter (nor=80) parameter (u0=28) character*1 ty(nat,nor) integer*4 io,ia,nao,nat,nop(*),nxi(u0),nyi(u0),nzi(u0), 1ish(nat,nor),ioo,ip,ipx,npi,npii,nend,nlim real*8 ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28),aad(u0,u0),aaf(u0,u0),aa1(u0,u0), 1aag(u0,u0),aah(u0,u0),aaii(u0,u0),aai(u0,u0),cci(u0),xv(3,nat), 1alpha(nat,nor),orb(nao),rx,ry,rz,x,y,z,ar2,a,ecp,EF,b6 logical ld5,lf7,lg9,lh11,li13 call initfd(aa1,aad,aaf,aag,aah,aaii) orb=0.0d0 io=0 if(nlim.eq.0)then nend=nat else nend=nlim endif do 2 ia=1,nend x=rx-xv(1,ia) y=ry-xv(2,ia) z=rz-xv(3,ia) ar2=x*x+y*y+z*z do 3 ip=1,nop(ia) a=alpha(ia,ip) ecp=a*ar2 call nppp(ty(ia,ip),npi,npii,cci,nxi,nyi,nzi, 1aai,aa1,aad,aaf,aag,aah,aaii,ld5,lf7,ia,ip,lg9,lh11,li13, 1nat,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I) if(ecp.le.23.0D0)then EF=exp(-ecp) do 4 ipx=1,npi b6=cci(ipx)*EF if(nxi(ipx).gt.0)b6=b6*x**nxi(ipx) if(nyi(ipx).gt.0)b6=b6*y**nyi(ipx) if(nzi(ipx).gt.0)b6=b6*z**nzi(ipx) c (x-xa)^nx (y-ya)^ny (z-za)^nz exp(-ar^2) if(npi.ne.npii)then do 74 ioo=1,npii 74 orb(io+ioo)=orb(io+ioo)+aai(ioo,ipx)*b6 else orb(io+ipx)=orb(io+ipx)+b6 endif 4 continue endif if(ish(ia,ip+1).gt.ish(ia,ip))io=io+npii 3 continue 2 continue return end subroutine grorb(o0,orb,rx,ry,rz,ty,nao,nat,xv,nop,alpha,ish,nlim, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13) c o0 .. orbital values at point rx ry rz c orb .. gradient orbital values at point rx ry rz implicit none integer*4 nor,u0 parameter (nor=80) parameter (u0=28) character*1 ty(nat,nor) integer*4 io,ia,nao,nat,nop(*),nxi(u0),nyi(u0),nzi(u0), 1ish(nat,nor),ioo,ip,ipx,npi,npii,nend,nlim,nx,ny,nz real*8 ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2),bo, 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28),aad(u0,u0),aaf(u0,u0),aa1(u0,u0), 1aag(u0,u0),aah(u0,u0),aaii(u0,u0),aai(u0,u0),cci(u0),xv(3,nat), 1alpha(nat,nor),orb(nao,3),rx,ry,rz,x,y,z,ar2,a,ecp,EF,b6, 1b6x,b6y,b6z,o0(nao),xx,yy,zz logical ld5,lf7,lg9,lh11,li13 call initfd(aa1,aad,aaf,aag,aah,aaii) o0=0.0d0 orb=0.0d0 io=0 if(nlim.eq.0)then nend=nat else nend=nlim endif do 2 ia=1,nend x=rx-xv(1,ia) y=ry-xv(2,ia) z=rz-xv(3,ia) ar2=x*x+y*y+z*z do 3 ip=1,nop(ia) a=alpha(ia,ip) ecp=a*ar2 call nppp(ty(ia,ip),npi,npii,cci,nxi,nyi,nzi, 1aai,aa1,aad,aaf,aag,aah,aaii,ld5,lf7,ia,ip,lg9,lh11,li13, 1nat,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I) if(ecp.le.23.0D0)then EF=exp(-ecp) do 4 ipx=1,npi nx=nxi(ipx) ny=nyi(ipx) nz=nzi(ipx) xx=x**nx yy=y**ny zz=z**nz b6 =xx*yy*zz*cci(ipx)*EF bo=-2.0d0*a*b6 b6x=bo*x b6y=bo*y b6z=bo*z if(nx.gt.0)b6x=b6x+dble(nx)*x**(nx-1)*yy*zz*b6 if(ny.gt.0)b6y=b6y+dble(ny)*y**(ny-1)*zz*xx*b6 if(nz.gt.0)b6z=b6z+dble(nz)*z**(nz-1)*xx*yy*b6 c o =(x-xa)^nx (y-ya)^ny (z-za)^nz ] exp(-ar^2) c gx=[nx(x-xa)^(nx-1)-2a (x-xa)^(nx+1)] (y-ya)^ny (z-za)^nz ] exp(-ar^2) c etc if(npi.ne.npii)then do 74 ioo=1,npii o0(io+ioo) =o0(io+ioo) +aai(ioo,ipx)*b6 orb(io+ioo,1)=orb(io+ioo,1)+aai(ioo,ipx)*b6x orb(io+ioo,2)=orb(io+ioo,2)+aai(ioo,ipx)*b6y 74 orb(io+ioo,3)=orb(io+ioo,3)+aai(ioo,ipx)*b6z else o0(io+ipx)=o0(io+ipx)+b6 orb(io+ipx,1)=orb(io+ipx,1)+b6x orb(io+ipx,2)=orb(io+ipx,2)+b6y orb(io+ipx,3)=orb(io+ipx,3)+b6z endif 4 continue endif if(ish(ia,ip+1).gt.ish(ia,ip))io=io+npii 3 continue 2 continue return end subroutine sorb(orb,x,y,z,ty,nao,nat,xv,nop,alpha,ish, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13,nlim) c orb .. integrals of orbitals a b c / c | a(r)b(r) c orb = | -------- dr c | |r-R| c / c c nlim ... limit of atoms, if zero include all implicit none integer*4 nor,u0,mmax parameter (nor=80,u0=28,mmax=21) character*1 ty(nat,nor) integer*4 io,ia,nao,nat,nop(*),nxi(u0),nyi(u0),nzi(u0), 1ish(nat,nor),ioo,ip,ipx,npi,npii,mifu,m1,m2,m12,mmx,ja, 1jo,joo,jp,jpx,npj,npjj,nxj(u0),nyj(u0),nzj(u0), 1n1x,n1y,n1z,n2x,n2y,n2z,nlim real*8 ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2),eep(mmax), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28),aad(u0,u0),aaf(u0,u0),aa1(u0,u0), 1aag(u0,u0),aah(u0,u0),aaii(u0,u0),aai(u0,u0),cci(u0),xv(3,nat), 1alpha(nat,nor),orb(nao,nao),x,y,z,atol,ccj(u0), 1b6,z0,pi,al,pi3,cl,dd,hsq,cd,cdi,ai,aa,bb,ab,abi, 1xij,yij,zij,t,hsp,GAB,pqx,pqy,pqz,xi,yi,zi,xj,yj,zj, 1rij,aj,px,py,pz,uu,aaj(u0,u0),oce2,tol,ax,ii logical ld5,lf7,lg9,lh11,li13 call initfd(aa1,aad,aaf,aag,aah,aaii) atol=1.0d-11 tol=23.0d0 z0=0.0d0 al=1.0d5 pi=4.0d0*datan(1.0d0) pi3=pi*pi*pi cl=dsqrt((al/pi)**3) dd=al+al hsq=0.5d0/al cd=al cdi=1.0d0/cd orb=z0 io=0 do 2 ia=1,nat xi=xv(1,ia) yi=xv(2,ia) zi=xv(3,ia) do 3 ip=1,nop(ia) ai=alpha(ia,ip) aa=ai+ai call nppp(ty(ia,ip),npi,npii,cci,nxi,nyi,nzi, 1aai,aa1,aad,aaf,aag,aah,aaii,ld5,lf7,ia,ip,lg9,lh11,li13, 1nat,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I) m1=mifu(ty(ia,ip)) jo=0 do 21 ja=1,ia xj=xv(1,ja) yj=xv(2,ja) zj=xv(3,ja) xij=xj-xi yij=yj-yi zij=zj-zi rij=xij**2+yij**2+zij**2 do 31 jp=1,nop(ja) aj=alpha(ja,jp) bb=aj+aj ab=ai+aj abi=1.0d0/ab px=(ai*xi+aj*xj)/ab py=(ai*yi+aj*yj)/ab pz=(ai*zi+aj*zj)/ab t=ai*aj/(ai+aj)*rij hsp=0.5d0/ab call nppp(ty(ja,jp),npj,npjj,ccj,nxj,nyj,nzj, 1aaj,aa1,aad,aaf,aag,aah,aaii,ld5,lf7,ja,jp,lg9,lh11,li13, 1nat,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I) m2=mifu(ty(ja,jp)) IF((nlim.eq.0).or.(ia.le.nlim.and.ja.le.nlim))THEN if(t.lt.23.0d0)then GAB=exp(-t) uu=cl*pi3*GAB*dsqrt((abi*cdi)**3) m12=m1+m2 call iactivate(m12,0,x,y,z,px,py,pz,eep,pqx,pqy,pqz,hsp,hsq,tol) do 4 ipx=1,npi n1x=nxi(ipx) n1y=nyi(ipx) n1z=nzi(ipx) do 4 jpx=1,npj n2x=nxj(jpx) n2y=nyj(jpx) n2z=nzj(jpx) mmx=n1x+n1y+n1z+n2x+n2y+n2z ii=oce2(n1x,n1y,n1z,n2x,n2y,n2z,0,0,0,0,0,0, 1 xij,yij,zij,z0,z0,z0,pqx,pqy,pqz, hsp,hsq,aa,bb,z0,dd, 2 mmx,eep,atol) b6=cci(ipx)*ccj(jpx)*uu*ii c numerical check c iin=iinf(n1x,n1y,n1z,n2x,n2y,n2z,ai,aj,x,y,z,xi,yi,zi, c 1 xj,yj,zj) c write(6,609)n1x,n1y,n1z,n2x,n2y,n2z,ii*uu,iin c09 format(6i1,2e12.4) c if(dabs(iin-uu*ii).gt.1.0d-3)then c write(6,610)ia,ip,m1,ja,jp,m2,ai,aj c 610 format(' ia ip m1 ja jp m2 ai aj ',3i2,1x,3i2,2e12.4) c endif c b6=cci(ipx)*ccj(jpx)*iin if(npi.ne.npii.or.npj.ne.npjj)then do 74 ioo=1,npii if(aai(ioo,ipx).ne.0.0d0)then ax=aai(ioo,ipx)*b6 do 741 joo=1,npjj 741 orb(io+ioo,jo+joo)=orb(io+ioo,jo+joo)+ax*aaj(joo,jpx) endif 74 continue else orb(io+ipx,jo+jpx)=orb(io+ipx,jo+jpx)+b6 endif 4 continue endif ENDIF if(ish(ja,jp+1).gt.ish(ja,jp))jo=jo+npjj 31 continue 21 continue if(ish(ia,ip+1).gt.ish(ia,ip))io=io+npii 3 continue 2 continue do 5 ia=1,nao do 5 ja=1,ia-1 5 orb(ja,ia)=orb(ia,ja) return end function iinf(n1x,n1y,n1z,n2x,n2y,n2z,ai,aj,x,y,z,xi,yi,zi, 1xj,yj,zj) c / c | (x-xa)^n1x*(X-xb)^n2x*(y-ya)^n1y*(y-yb)^n2y*(z-za)^n1z*(z-zb)^n2z c | *exp[-ai(r-A)^2]*exp[-aj(r-B)^2] c orb = | ------------------------------------------------------------------- dr c | |r-R| c / implicit none integer*4 n1x,n1y,n1z,n2x,n2y,n2z,n,i,j,k real*8 ai,aj,ab,x,y,z,xi,yi,zi,iinf,s,xx,yy,zz,e1,e2, 1px,py,pz,t,xr,yr,zr,d,xj,yj,zj,del,e0 iinf=0.0d0 n=100 ab=ai+aj t=ai*aj*((xi-xj)**2+(yi-yj)**2+(zi-zj)**2)/ab if(t.gt.23.0d0)return e0=exp(-t) del=5.0d0/dsqrt(ab) px=(xi*ai+xj*aj)/ab py=(yi*ai+yj*aj)/ab pz=(zi*ai+zj*aj)/ab d=2.0d0*del/dble(n) xx=px-del s=0.0d0 do 1 i=1,n xx=xx+d t=ab*(xx-px)**2 if(t.lt.23.0d0)then xr=(xx-x)**2 e1=exp(-t)*(xx-xi)**n1x*(xx-xj)**n2x yy=py-del do 2 j=1,n yy=yy+d t=ab*(yy-py)**2 if(t.lt.23.0d0)then yr=(yy-y)**2 e2=e1*exp(-t)*(yy-yi)**n1y*(yy-yj)**n2y zz=pz-del do 3 k=1,n zz=zz+d t=ab*(zz-pz)**2 zr=dsqrt((zz-z)**2+xr+yr) 3 if(t.lt.23.0d0.and.zr.gt.d/10.0d0) 1 s=s+e2*exp(-t)*(zz-zi)**n1z*(zz-zj)**n2z/zr endif 2 continue endif 1 continue iinf=s*e0*d**3 return end subroutine gorb(ix,orb,x,y,z,ty,nao,nat,xv,nop,alpha,ish, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13,nlim) c orb .. integrals of orbitals a b c / c | a(r)b(r)(r-R)_ix c orb = | ---------------- dr c | |r-R|^3 c / c c nlim ... limit of atoms, if zero include all implicit none integer*4 nor,u0,mmax parameter (nor=80,u0=28,mmax=21) character*1 ty(nat,nor) integer*4 io,ia,nao,nat,nop(*),nxi(u0),nyi(u0),nzi(u0), 1ish(nat,nor),ioo,ip,ipx,npi,npii,mifu,m1,m2,m12,mmx,ix,ja, 1jo,joo,jp,jpx,npj,npjj,nxj(u0),nyj(u0),nzj(u0),nxl,nyl,nzl, 1n1x,n1y,n1z,n2x,n2y,n2z,nlim real*8 ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2),eep(mmax), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28),aad(u0,u0),aaf(u0,u0),aa1(u0,u0), 1aag(u0,u0),aah(u0,u0),aaii(u0,u0),aai(u0,u0),cci(u0),xv(3,nat), 1alpha(nat,nor),orb(nao,nao),x,y,z,atol,ccj(u0), 1b6,z0,pi,al,pi3,cl,dd,hsq,cd,cdi,ai,aa,bb,ab,abi, 1xij,yij,zij,t,hsp,GAB,pqx,pqy,pqz,xi,yi,zi,xj,yj,zj, 1rij,aj,px,py,pz,uu,aaj(u0,u0),oce2,tol,ax,ii logical ld5,lf7,lg9,lh11,li13 call initfd(aa1,aad,aaf,aag,aah,aaii) atol=1.0d-11 tol=23.0d0 z0=0.0d0 al=1.0d4 pi=4.0d0*datan(1.0d0) pi3=pi*pi*pi cl=-2.0d0*dsqrt(al**5/pi**3) dd=al+al hsq=0.5d0/al cd=al cdi=1.0d0/cd orb=z0 nxl=0 nyl=0 nzl=0 if(ix.eq.1)nxl=1 if(ix.eq.2)nyl=1 if(ix.eq.3)nzl=1 io=0 do 2 ia=1,nat xi=xv(1,ia) yi=xv(2,ia) zi=xv(3,ia) do 3 ip=1,nop(ia) ai=alpha(ia,ip) aa=ai+ai call nppp(ty(ia,ip),npi,npii,cci,nxi,nyi,nzi, 1aai,aa1,aad,aaf,aag,aah,aaii,ld5,lf7,ia,ip,lg9,lh11,li13, 1nat,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I) m1=mifu(ty(ia,ip)) jo=0 do 21 ja=1,ia xj=xv(1,ja) yj=xv(2,ja) zj=xv(3,ja) xij=xj-xi yij=yj-yi zij=zj-zi rij=xij**2+yij**2+zij**2 do 31 jp=1,nop(ja) aj=alpha(ja,jp) bb=aj+aj ab=ai+aj abi=1.0d0/ab px=(ai*xi+aj*xj)/ab py=(ai*yi+aj*yj)/ab pz=(ai*zi+aj*zj)/ab t=ai*aj/(ai+aj)*rij hsp=0.5d0/ab call nppp(ty(ja,jp),npj,npjj,ccj,nxj,nyj,nzj, 1aaj,aa1,aad,aaf,aag,aah,aaii,ld5,lf7,ja,jp,lg9,lh11,li13, 1nat,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I) m2=mifu(ty(ja,jp)) IF((nlim.eq.0).or.(ia.le.nlim.and.ja.le.nlim))THEN if(t.lt.23.0d0)then GAB=exp(-t) uu=-cl*pi3*GAB*dsqrt((abi*cdi)**3) m12=m1+m2 call iactivate(m12,1,x,y,z,px,py,pz,eep,pqx,pqy,pqz,hsp,hsq,tol) do 4 ipx=1,npi n1x=nxi(ipx) n1y=nyi(ipx) n1z=nzi(ipx) do 4 jpx=1,npj n2x=nxj(jpx) n2y=nyj(jpx) n2z=nzj(jpx) mmx=n1x+n1y+n1z+n2x+n2y+n2z+1 ii=oce2(n1x,n1y,n1z,n2x,n2y,n2z,0,0,0,nxl,nyl,nzl, 1 xij,yij,zij,z0,z0,z0,pqx,pqy,pqz, hsp,hsq,aa,bb,z0,dd, 2 mmx,eep,atol) b6=uu*cci(ipx)*ccj(jpx)*ii if(npi.ne.npii.or.npj.ne.npjj)then do 74 ioo=1,npii if(aai(ioo,ipx).ne.0.0d0)then ax=aai(ioo,ipx)*b6 do 741 joo=1,npjj 741 orb(io+ioo,jo+joo)=orb(io+ioo,jo+joo)+ax*aaj(joo,jpx) endif 74 continue else orb(io+ipx,jo+jpx)=orb(io+ipx,jo+jpx)+b6 endif 4 continue endif ENDIF if(ish(ja,jp+1).gt.ish(ja,jp))jo=jo+npjj 31 continue 21 continue if(ish(ia,ip+1).gt.ish(ia,ip))io=io+npii 3 continue 2 continue do 5 ia=1,nao do 5 ja=1,ia-1 5 orb(ja,ia)=orb(ia,ja) return end function oce2(nxi,nyi,nzi,nxj,nyj,nzj,nxk,nyk,nzk,nxl,nyl,nzl, 1xij,yij,zij,xkl,ykl,zkl,pqx,pqy,pqz, hsp,hsq,aa,bb,cc,dd, 2mmx,eep,atol) c c the coulomb integral (ij||kl) (AO) by the eight-term reccurence c relationship c implicit real*8 (a-h,o-z) implicit integer*4 (i-n) c parameter (mmax=21,lx4=1000) c dimension nm(12,lx4),mp(lx4),mt(lx4),nu(12),nmil(12) common/numbers/z0,one,two,three,four,five,half,a10 dimension eep(mmax),eeq(mmax),p(lx4),id(lx4), 1issn(12) dimension w(15),ihsp(12),itobb(12),itocb(12), 1itodb(12),irib(12),ibbb(12),ixb(12),rl(3) logical lic data issn/1,4,16,64,256,1024,4096,16384,65536,262144,1048576, 14194304/ data rl/1.0d0,2.0d0,3.0d0/ data ihsp /10,10,10, 10,10,10, 11,11,11, 11,11,11/ data itobb/ 4, 5, 6, 1, 2, 3, 10,11,12, 7, 8, 9/ data itocb/ 7, 8, 9, 7, 8, 9, 1, 2, 3, 1, 2, 3/ data itodb/10,11,12, 10,11,12, 4, 5, 6, 4, 5, 6/ data irib / 7, 8, 9, 7, 8, 9, -7,-8,-9, -7,-8,-9/ data ibbb /13,13,13, 12,12,12, 15,15,15, 14,14,14/ data ixb / 1, 2, 3, -1,-2,-3, 4, 5, 6, -4,-5,-6/ data i224/16777216/ c if(mmx.eq.0)then oce2=eep(1) return endif c oce2=0.0d0 c do 4444 ii=1,mmx+1 4444 eeq(ii)=z0 c l=1 p(1)=one nu( 1)=nxi nu( 2)=nyi nu( 3)=nzi nu( 4)=nxj nu( 5)=nyj nu( 6)=nzj nu( 7)=nxk nu( 8)=nyk nu( 9)=nzk nu(10)=nxl nu(11)=nyl nu(12)=nzl do 4 ii=1,12 4 nm(ii,1)=nu(ii) c c mp is the kind of the error function + 1 (!!!!) c mt is sum of momenta c id: indentification number, for each [ab|cd](m), m included as m*2^24 id(1)=nxi+4*(nyi+4*(nzi+4*(nxj+4*(nyj+4*(nzj+ 14*(nxk+4*(nyk+4*(nzk+4*(nxl+4*(nyl+4*nzl)))))))))) mp(1)=1 mt(1)=mmx w( 1)=xij w( 2)=yij w( 3)=zij w( 4)=xkl w( 5)=ykl w( 6)=zkl w( 7)=pqx w( 8)=pqy w( 9)=pqz w(10)=hsp w(11)=hsq w(12)=aa w(13)=bb w(14)=cc w(15)=dd c asiani=hsp*hsq c c look at all indices: do 1 itoa=1,12 if(nu(itoa).gt.0)THEN c c expand (A+1 b cd) asi=w(ihsp(itoa)) itob=itobb(itoa) itoc=itocb(itoa) itod=itodb(itoa) iri=irib(itoa) riasi=w(abs(iri))*asi if(iri.lt.0)riasi=-riasi ix=ixb(itoa) tbe=w(ibbb(itoa))*w(abs(ix))*asi if(ix.lt.0)tbe=-tbe iid=issn(itoa) c istart=1 50 lic=.false. newl=l c c look over all current expantion terms (ijkl)(m) do 3 il=istart,l if(nm(itoa,il).gt.0)then c c expand [a+1i ...](m) if a+1>0 c c ID for [ab|cd](m) ida=id(il)-iid c c write abcd into temporary buffer and record mp,m do 5 io=1,12 5 nmil(io)=nm(io,il) nai=nmil(itoa) nbi=nmil(itob) nci=nmil(itoc) ndi=nmil(itod) naim=nai-1 nmil(itoa)=naim if(nai.gt.1)then if(.not.lic)then istart=il lic=.true. endif endif pold=p(il) mpold=mp(il) mpoldp=mpold+1 mold=mt(il) moldm=mold-1 moldmm=moldm-1 c (8) if(ndi.gt.0)then p1=pold*rl(ndi)*asiani if(mold.eq.2)then c take off the term [00|00][m] eeq(mpoldp)=eeq(mpoldp)+p1 else c c ID for [ab|cd-1](m+1) idd=ida-issn(itod)+i224 c look, if it already exists do 80 i1=newl,1,-1 if(idd.eq.id(i1))then p(i1)=p(i1)+p1 goto 81 endif 80 continue newl=newl+1 p(newl)=p1 id(newl)=idd mt(newl)=moldmm mp(newl)=mpoldp do io=1,12 nm(io,newl)=nmil(io) enddo nm(itod,newl)=nmil(itod)-1 81 continue endif endif c (7) if(nci.gt.0)then p1=pold*rl(nci)*asiani if(mold.eq.2)then c take off the term [00|00][m] eeq(mpoldp)=eeq(mpoldp)+p1 else c c ID for [ab|c-1d](m+1) idd=ida-issn(itoc)+i224 do 82 i1=newl,1,-1 if(idd.eq.id(i1))then p(i1)=p(i1)+p1 goto 83 endif 82 continue newl=newl+1 p(newl)=p1 id(newl)=idd mt(newl)=moldmm mp(newl)=mpoldp do io=1,12 nm(io,newl)=nmil(io) enddo nm(itoc,newl)=nmil(itoc)-1 83 continue endif endif c (6,5) if(nbi.gt.0)then p1=pold*rl(nbi)*asi p2=-p1*asi if(mold.eq.2)then c take off the terms [00|00][m] eeq(mpold)=eeq(mpold)+p1 eeq(mpoldp)=eeq(mpoldp)+p2 else c c ID for [ab-1|cd](m) idd1=ida-issn(itob) do 72 i1=newl,1,-1 if(idd1.eq.id(i1))then p(i1)=p(i1)+p1 goto 73 endif 72 continue newl=newl+1 p(newl)=p1 id(newl)=idd1 mp(newl)=mpold mt(newl)=moldmm do io=1,12 nm(io,newl)=nmil(io) enddo nm(itob,newl)=nmil(itob)-1 73 continue c c ID for [ab-1|cd](m+1) idd=idd1+i224 do 74 i1=newl,1,-1 if(idd.eq.id(i1))then p(i1)=p(i1)+p2 goto 75 endif 74 continue newl=newl+1 p(newl)=p2 id(newl)=idd mp(newl)=mpoldp mt(newl)=moldmm do io=1,12 nm(io,newl)=nmil(io) enddo nm(itob,newl)=nmil(itob)-1 75 continue endif endif c (4,3) if(nai.gt.1)then p1=pold*rl(naim)*asi p2=-p1*asi if(mold.eq.2)then c take off the terms [00|00][m], [00|00][m+1] eeq(mpold)=eeq(mpold)+p1 eeq(mpoldp)=eeq(mpoldp)+p2 else c c ID for [a-1b|cd](m) idd=ida-iid do 76 i1=newl,1,-1 if(idd.eq.id(i1))then p(i1)=p(i1)+p1 goto 77 endif 76 continue newl=newl+1 p(newl)=p1 id(newl)=idd mp(newl)=mpold mt(newl)=moldmm do 6 io=1,12 6 nm(io,newl)=nmil(io) nm(itoa,newl)=nmil(itoa)-1 77 continue c c ID for [a-1b|cd](m+1) idd=ida-iid+i224 do 78 i1=newl,1,-1 if(idd.eq.id(i1))then p(i1)=p(i1)+p2 goto 79 endif 78 continue newl=newl+1 p(newl)=p2 id(newl)=idd mp(newl)=mpoldp mt(newl)=moldmm do 7 io=1,12 7 nm(io,newl)=nmil(io) nm(itoa,newl)=nmil(itoa)-1 79 continue endif endif c c (2) p1=pold*riasi if(abs(p1).gt.atol)then if(mold.eq.1)then c take off the term [00|00][m+1] eeq(mpoldp)=eeq(mpoldp)+p1 else c c ID for [ab|cd](m+1) idd=ida+i224 do 70 i1=newl,1,-1 if(idd.eq.id(i1))then p(i1)=p(i1)+p1 goto 71 endif 70 continue newl=newl+1 p(newl)=p1 id(newl)=idd mp(newl)=mpoldp mt(newl)=moldm do 8 io=1,12 8 nm(io,newl)=nmil(io) 71 continue endif endif c (1) c c ID for [ab|cd](m) p1=pold*tbe if(mold.eq.1)then eeq(mpold)=eeq(mpold)+p1 goto 300 endif if(abs(p1).lt.atol)goto 300 do 68 i1=newl,1,-1 if(ida.eq.id(i1))then if(i1.ne.il)then p(i1)=p(i1)+p1 goto 300 endif endif 68 continue c c accept it: id(il)=ida p(il)=p1 mt(il)=moldm c mp(il)the same nm(itoa,il)=naim endif 3 continue goto 301 c c get rid of the il term outside the loop 3 300 do 302 i1=il,newl-1 ip=i1+1 p (i1)=p (ip) id(i1)=id(ip) mp(i1)=mp(ip) mt(i1)=mt(ip) do 302 io=1,12 302 nm(io,i1)=nm(io,ip) newl=newl-1 if(.not.lic)then istart=il lic=.true. endif 301 l=newl if(l+8.ge.lx4)goto 9999 if(lic)goto 50 c ENDIF 1 continue c sum=z0 do 2 i1=1,mmx+1 2 sum=sum+eeq(i1)*eep(i1) oce2=sum return c 9999 write(6,3001) nxi,nyi,nzi,nxj,nyj,nzj,nxk,nyk,nzk,nxl,nyl,nzl, 1xij,yij,zij,xkl,ykl,zkl,pqx,pqy,pqz, hsp,hsq,aa,bb,cc,dd, 2mmx,eep(1),atol do ll=1,l write(6,8000)ll,(nm(io,ll),io=1,12),mp(ll),mt(ll) 8000 format(i4,12i2,2i5) enddo 3001 format( 'nxi,nyi,nzi,nxj,nyj,nzj,nxk,nyk,nzk,nxl,nyl,nzl',/, 14(1x,3i2),/, 2'xij,yij,zij,xkl,ykl,zkl,pqx,pqy,pqz, hsp,hsq,aa,bb,cc,dd,',/, 33(3f12.6,/),/, 32f12.6,/,4f12.6,/, 4'mmx,eep(1),atol',/, 5i3,2f10.5) call report('expansion overflow in oce2 - OS RR') end function mifu(c) integer*4 mifu character*1 c if(c.eq.'S')mifu=0 if(c.eq.'P')mifu=1 if(c.eq.'L')mifu=1 if(c.eq.'D')mifu=2 if(c.eq.'F')mifu=3 if(c.eq.'G')mifu=4 if(c.eq.'H')mifu=5 if(c.eq.'M')mifu=2 return end subroutine iactivate(mij,mkl,qx,qy,qz,px,py,pz, 1 eep,pqx,pqy,pqz,hsp,hsq,tol) c c calculates the [0](m) functions up to mmx implicit real*8 (a-h,o-z) implicit integer*4 (i-n) parameter (mmax=21,nX=2000) dimension eep(mmax),eeq(mmax) common/ap4/et(nX),ei(mmax,nX),dt(mmax),dt63(mmax),dt62(mmax), 1ti(mmax),t5(mmax),dtt,t23,dtt2,dtt3 common/numbers/z0,one,two,three,four,five,half,a10 common/const/pi,spt,bohr c mmx=mkl+mij am=dble(mmx) itm=mmx+mmx twoam=am+am m1=mmx+1 c pqx=qx-px pqy=qy-py pqz=qz-pz r2=pqx*pqx+pqy*pqy+pqz*pqz sq1=half/(hsp+hsq) sq2=sq1+sq1 sq22=sqrt(sq2) t=sq1*r2 c c initialize sq22^(2m+1), m=0..mmx: eeq(1)=sq22 dum=sq22*sq22 do 44 m=1,mmx eeq(m+1)=eeq(m)*dum 44 continue c c initialize ee(T,m) * sq22**(2m+1): c c 1) initialize function EE4(T,m) for m=mmx c c The approximate error function c c 1 c / c | 2m -Tu^2 c E(T) = sqrt(2/pi) | u e du m=0..12 c | c / c 0 c c common app must be initialized befor use c c c if t>t5, use the limit formula c c for 0 nexc in chk') read(9,900)(e(i),(dl(i,j),j=1,3),(dv(i,j),j=1,3),(r(i,j),j=1,3), 1 (qv(i,j,j),j=1,3),((qv(i,j,k),k=j+1,3),j=1,2),i=1,n) 900 format(5e16.8) c use dv to avoid compiler messages: dv(1,1)=dv(1,1) do 2 i=1,n e(i)=e(i)-e0 qv(i,3,2)=qv(i,2,3) qv(i,3,1)=qv(i,1,3) 2 qv(i,2,1)=qv(i,1,2) write(6,*)'Excitation parameters re-read in chk format' endif goto 1 99 close(9) return end subroutine di12(n,nmo,nmo2,ncmm,ndo,mo1,mo2,mstart,mend,e,wcis) implicit none integer*4 n,nmo,nmo2,ncmm,ndo,mo1,mo2,mstart,mend,a,b real*8 e(*),wcis,wau,CM CM=219474.63d0 if(wcis.gt.1.0d-1)then wau=1.0d7/wcis/CM else wau=0.0d0 endif if(mo1.eq.0)then mstart=1 else if(mo1.gt.ndo)call report('mo1>ndo') mstart=mo1 endif if(mo2.eq.0)then mend=nmo else if(mo2.le.ndo.or.mo2.gt.nmo)then write(6,*)'mo2:',mo2 write(6,*)'ndo:',ndo write(6,*)'nmo:',nmo call report('mo2 ill-defined') endif mend=mo2 endif n=0 do 3 a=mstart,ndo do 3 b=ndo+1,mend 3 if(wcis.lt.1.0d-1.or.e(b)-e(a).lt.wau)n=n+1 nmo2=nmo**2 ncmm=1 if(wcis.gt.1.0d-1)write(6,67)n,wcis 67 format(i10,' transition wave lengths longer than',f10.2,' nm') return end subroutine cis(n,na,nb,eorb,dl,r,eau,ni,natt,cij,lopen, 1mstart,mend,aij,bij,fo,qz,ndo,nmo,ncis,dcis,xcis,wcis, 1loniom,io1,io2) implicit none character*80 s80 character*(*) fo logical lopen integer*4 I,na,nb,n,ni(*),nd0,aij(*),bij(*),j,natt, 1qz(*),a,b,ndo,nmo2,ix,mend,mstart,nmo,io1,io2 parameter (nd0=21) real*8 dl(n,3),r(n,3),eau(*),cij(*),eorb(*), 1debye,ds,rs,dcis,xcis,ncis,l,lp,CM,wcis,wau,eaut integer*4,allocatable::ipse(:) real*8,allocatable::bp(:),bpd(:) logical loniom write(6,*)'cis' CM=219474.63d0 nmo2=nmo**2 if(wcis.gt.1.0d-1)then wau=1.0d7/wcis/CM else wau=0.0d0 endif open(2,file=fo) 1 read(2,2000,end=2,err=2)s80 2000 format(a80) if(s80(40:50).eq.'Pseudopoten')then write(6,2000)s80 allocate(ipse(natt)) call rdps(natt,ipse) j=0 do 335 i=1,natt if(ipse(i).ne.0)then if(.not.loniom.or.(i.ge.io1.and.i.le.io2))then j=j+1 write(6,6885)i,ipse(i) 6885 format(' atom ',i6,' atomic charge reduced to',i4) qz(j)=ipse(i) endif endif 335 continue endif if(s80(8:22).eq.'alpha electrons')then write(6,2000)s80 read(s80( 1: 6),*)na read(s80(25:31),*)nb goto 2 endif goto 1 c 2 close(2) lopen=na.ne.nb if(lopen)call report('open shell not yet') c read one electron integrals: allocate(bp(nd0*nmo2),bpd(nd0*nmo2)) call rwm(bp,nmo,nd0) if(lopen)call rwmd(bpd,nmo) n=0 do 3 a=mstart,ndo do 3 b=ndo+1,mend eaut=eorb(b)-eorb(a) if(wcis.lt.1.0d-1.or.eaut.lt.wau)then n=n+1 ni(n)=1 cij(n)=1.0d0 aij(n)=a bij(n)=b eau(n)=eaut do 4 ix=1,3 dl(n,ix)=bp(a+nmo*(b-1)+nmo2*(0 +ix-1)) 4 r( n,ix)=bp(a+nmo*(b-1)+nmo2*(6 +ix-1)) endif 3 continue c 1.. 3 el. dipole, c 4.. 6 gradient, c 7.. 9 magnetic dipole, c 10..12 magnetic "GIAO" c 13..18 quadrupole XX XY XZ YY YZ ZZ c 19..21 GIAO if(ncis.ne.0)then write(6,600)xcis,xcis,ncis,xcis,dcis 600 format(/,' lp = ',f10.2,' x ( l /',f10.2,')^',f8.2,/,/, 1 ' d = d x exp[-(l-',f10.2,')^2/',f10.2,'^2]',/) do 7 i=1,n l=1.0d7/(eau(i)*CM) lp=xcis*(l/xcis)**ncis eau(i)=(1.0d7/lp)/CM do 7 ix=1,3 7 if(l.gt.xcis)dl(i,ix)=dl(i,ix)*exp(-((l-xcis)/dcis)**2) endif open(9,file='CIS.TAB') open(91,file='MOMENTS.TAB') write(9,900) 900 format(' Simple CIS Method',/,' freq D R',/,60(1h-)) debye=2.541747758d0 do 6 i=1,n ds=dl(i,1)*dl(i,1)+dl(i,2)*dl(i,2)+dl(i,3)*dl(i,3) rs=dl(i,1)*r( i,1)+dl(i,2)*r( i,2)+dl(i,3)*r( i,3) ds=ds*debye**2 rs=rs*debye**2 if(dabs(ds).lt.1.0d-20)ds=0.0d0 if(dabs(rs).lt.1.0d-20)rs=0.0d0 write(91,525)i,(dl(i,ix),ix=1,3),(r(i,ix),ix=1,3) 525 FORMAT(I9,6E11.3) 6 write(9,523)i,1.0d7/(eau(i)*219474.0d0),ds,rs,rs,aij(i),bij(i) 523 FORMAT(I9,f11.2,2G14.5,G12.2,i5,' ->',i5) write(9,524) 524 FORMAT(60(1h-)) close(9) close(91) write(6,*)'CIS.TAB' write(6,*)'MOMENTS.TAB' return end subroutine rwm(b,n,nd0) implicit none integer*4 i,j,k,n,n2,nd00,nd0 real*8 b(*) real*8 ,allocatable::p(:,:) parameter (nd00=21) character*2 ss(nd00) character*15 fn data ss/'PX','PY','PZ','VX','VY','VZ','LX','LY','LZ', 1 'DX','DY','DZ','XX','XY','XZ','YY','YZ','ZZ', 1 'EX','EY','EZ'/ c 1 2 3 4 5 6 7 8 9 c 10 11 12 13 14 15 16 17 18 c 19 20 21 c D .. r x rj c E .. r x ri if(nd0.ne.nd00)call report('nd0 <> nd00') allocate(p(n,n)) n2=n**2 do 1 i=1,9 c only p and r: if(i.lt.4.or.i.gt.6)then c do 1 i=1,nd00 if(i.gt.12.and.i.le.18)then fn='Q'//ss(i)//'.MO.SCR.TXT' else fn=ss(i)//'.MO.SCR.TXT' endif open(38,file=fn,status='old') call rmtr38(p,n,n,1) close(38) do 3 j=1,n do 3 k=1,n 3 b(n2*(i-1)+n*(k-1)+j)=p(k,j) write(6,8000)i,fn 8000 format(i4,2x,a15,'read') endif 1 continue return end subroutine rwmd(b,n) implicit none integer*4 i,j,k,n,n2 real*8 b(*) real*8 ,allocatable::p(:,:) character*3 ss(18) data ss/'PBX','PBY','PBZ','VBX','VBY','VBZ','LBX','LBY','LBZ', 1'WBX','WBY','WBZ','BXX','BXY','BXZ','BYY','BYZ','BZZ'/ logical lex allocate(p(n,n)) n2=n**2 do 1 i=1,9 if(i.gt.12)then inquire(file='Q'//ss(i)//'.MO.SCR.TXT',exist=lex) else inquire(file=ss(i)//'.MO.SCR.TXT',exist=lex) endif if(lex)then if(i.gt.12)then open(38,file='Q'//ss(i)//'.MO.SCR.TXT') else open(38,file=ss(i)//'.MO.SCR.TXT') endif call rmtr38(p,n,n,1) close(38) do 3 j=1,n do 3 k=1,n 3 b(n2*(i-1)+n*(k-1)+j)=p(k,j) else write(6,*)ss(i)//'.MO.SCR.TXT not present' endif 1 continue return end subroutine overlap6(nat,nao,ty,xv,nop,alpha,ish, 1ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I,ld5,lf7,lg9,lh11,li13) c the "true" d-orbitals are included here c calculates overlap matrix and other one electron integrals c symmetry properties of overlaps are not used, because of control implicit real*8 (a-h,o-z) implicit integer*4 (i-n) parameter (nor=80,n1e=28) character*1 ty(nat,nor) c n1e: c 1 c 2 c 3 c 4 c 5 c 6 c 7 c 8 c 9 c 10 c 11 c 12 c 13 c 14 c 15 c 16 c 17 (1/2) (r-rj) x grad W c 18 (1/2) (r-rj) x grad c 19 (1/2) (r-rj) x grad c 20 (1/2) (r-(ri+rj)/2) x grad T c 21 (1/2) (r-(ri+rj)/2) x grad c 22 (1/2) (r-(ri+rj)/2) x grad c 23 (1/2) rj x r / 2 D c 24 (1/2) rj x r / 2 c 25 (1/2) rj x r / 2 c 26 (1/2) ri x r / 2 E c 27 (1/2) ri x r / 2 c 28 (1/2) ri x r / 2 real*8 ccs(nat,nor),ccp(nat,nor),ccd(nat,nor,2), 1ccf(nat,nor,3),cci_G(nat,nor,15),cci_H(nat,nor,21), 2cci_I(nat,nor,28) integer*4 u0 parameter (u0=28) c n1e ... number of kinds of one-electron integrals common/const/pi,spt,bohr common/numbers/z0,one,two,three,four,five,half,a10 dimension nxi(u0),nyi(u0),nzi(u0),xv(3,nat),nop(*),ish(nat,nor), 1nxj(u0),nyj(u0),nzj(u0),cci(u0),ccj(u0),alpha(nat,nor), 3b6(n1e,u0,u0),aai(u0,u0),aaj(u0,u0), 4aad(u0,u0),aaf(u0,u0),aa1(u0,u0), 4aag(u0,u0),aah(u0,u0),aaii(u0,u0) logical lsprint,lpprint,lqprint,ld5,lvprint,llprint,lf7, 1lg9,lh11,li13,lnno,ldisk real*8, allocatable::s(:,:),sv(:,:,:) allocate(s(nao,nao),sv(n1e,u0,nao)) lsprint=.false. lpprint=.false. lqprint=.false. lqprint=.false. lvprint=.false. llprint=.false. lnno=.false. call inipoly i0=0 ione=1 itwo=2 call initfd(aa1,aad,aaf,aag,aah,aaii) c inquire(file='V.SCR',exist=ldisk) if(ldisk)then write(6,*)'V.SCR exists, skip overlap6' return endif c tol=100.0d0 spi=sqrt(pi*pi*pi) do 10 i=1,nao do 10 j=1,u0 do 10 k=1,n1e 10 sv(k,j,i)=z0 write(6,4000)nao,nat 4000 format(' Overlap6:',I6,' orbitals,',I6,' atoms') C open(33,file='SAO.SCR',form='unformatted') open(34,file='P.SCR',form='unformatted') open(35,file='Q.SCR',form='unformatted') open(36,file='V.SCR',form='unformatted') open(37,file='L.SCR',form='unformatted') open(38,file='W.SCR',form='unformatted') open(39,file='T.SCR',form='unformatted') open(40,file='D.SCR',form='unformatted') open(41,file='E.SCR',form='unformatted') c C atom i, orbital io io=0 do 2 ia=1,nat xi=xv(1,ia) yi=xv(2,ia) zi=xv(3,ia) c c primitive functions on atom ia: do 3 ip=1,nop(ia) ai=alpha(ia,ip) call nppp(ty(ia,ip),npi,npii,cci,nxi,nyi,nzi, 1aai,aa1,aad,aaf,aag,aah,aaii,ld5,lf7,ia,ip,lg9,lh11,li13, 1nat,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I) c C atom j, orbital jo jo=0 do 4 ja=1,nat xj=xv(1,ja) yj=xv(2,ja) zj=xv(3,ja) xij=xj-xi yij=yj-yi zij=zj-zi x2ij=xij*xij y2ij=yij*yij z2ij=zij*zij r2ij=x2ij+y2ij+z2ij xx=(xi+xj)*half yy=(yi+yj)*half zz=(zi+zj)*half c c primitive functions on atom ja: do 5 jp=1,nop(ja) aj=alpha(ja,jp) call nppp(ty(ja,jp),npj,npjj,ccj,nxj,nyj,nzj, 1aaj,aa1,aad,aaf,aag,aah,aaii,ld5,lf7,ja,jp,lg9,lh11,li13, 1nat,ccs,ccp,ccd,ccf,cci_G,cci_H,cci_I) aij=ai+aj tt=one/aij t=sqrt(tt) ec=ai*aj*r2ij*tt ef=z0 if(ec.lt.tol)then ef=spi*exp(-ec) else goto 777 endif c C Loop over orbitals to which the primitives ip, jp contribute do 71 joo=1,npj con=ef*ccj(joo) anjx=dble(nxj(joo)) anjy=dble(nyj(joo)) anjz=dble(nzj(joo)) do 71 ioo=1,npi coe=con*cci(ioo) sx=oi(i0,nxi(ioo),nxj(joo),ai,aj,xij,t,xi,xj) sy=oi(i0,nyi(ioo),nyj(joo),ai,aj,yij,t,yi,yj) sz=oi(i0,nzi(ioo),nzj(joo),ai,aj,zij,t,zi,zj) sxm=z0 sym=z0 szm=z0 if(nxj(joo).gt.0) 1sxm=oi(i0,nxi(ioo),nxj(joo)-1,ai,aj,xij,t,xi,xj) sxp=oi(i0,nxi(ioo),nxj(joo)+1,ai,aj,xij,t,xi,xj) if(nyj(joo).gt.0) 1sym=oi(i0,nyi(ioo),nyj(joo)-1,ai,aj,yij,t,yi,yj) syp=oi(i0,nyi(ioo),nyj(joo)+1,ai,aj,yij,t,yi,yj) if(nzj(joo).gt.0) 1szm=oi(i0,nzi(ioo),nzj(joo)-1,ai,aj,zij,t,zi,zj) szp=oi(i0,nzi(ioo),nzj(joo)+1,ai,aj,zij,t,zi,zj) ox =oi(ione,nxi(ioo),nxj(joo),ai,aj,xij,t,xi,xj) oy =oi(ione,nyi(ioo),nyj(joo),ai,aj,yij,t,yi,yj) oz =oi(ione,nzi(ioo),nzj(joo),ai,aj,zij,t,zi,zj) oxx=oi(itwo,nxi(ioo),nxj(joo),ai,aj,xij,t,xi,xj) oyy=oi(itwo,nyi(ioo),nyj(joo),ai,aj,yij,t,yi,yj) ozz=oi(itwo,nzi(ioo),nzj(joo),ai,aj,zij,t,zi,zj) dx=anjx*sxm-two*aj*sxp dy=anjy*sym-two*aj*syp dz=anjz*szm-two*aj*szp c overlap b6(1,ioo,joo)=sx*sy*sz c electric dipole b6(2,ioo,joo)=ox*sy*sz b6(3,ioo,joo)=sx*oy*sz b6(4,ioo,joo)=sx*sy*oz c electric quadrupole xx,xy,xz,yy,yz,zz: b6(5,ioo,joo)=oxx*sy*sz b6(6,ioo,joo)=ox*oy*sz b6(7,ioo,joo)=ox*sy*oz b6(8,ioo,joo)=oyy*sz*sx b6(9,ioo,joo)=sx*oy*oz b6(10,ioo,joo)=ozz*sx*sy c gradient/velocity d/dx, d/dy, d/dz b6(11,ioo,joo)=dx*sy*sz b6(12,ioo,joo)=dy*sz*sx b6(13,ioo,joo)=dz*sx*sy c angular momentum lx,ly,lz = (1/2) r x grad b6(14,ioo,joo)=(oy*dz-oz*dy)*sx*half b6(15,ioo,joo)=(oz*dx-ox*dz)*sy*half b6(16,ioo,joo)=(ox*dy-oy*dx)*sz*half c angular momentum (1/2) (r - rj) x grad b6(17,ioo,joo)=((oy-yj*sy)*dz-(oz-zj*sz)*dy)*sx*half b6(18,ioo,joo)=((oz-zj*sz)*dx-(ox-xj*sx)*dz)*sy*half b6(19,ioo,joo)=((ox-xj*sx)*dy-(oy-yj*sy)*dx)*sz*half c angular momentum (1/2) (r - (ri+rj)/2) x grad b6(20,ioo,joo)=((oy-yy*sy)*dz-(oz-zz*sz)*dy)*sx*half b6(21,ioo,joo)=((oz-zz*sz)*dx-(ox-xx*sx)*dz)*sy*half b6(22,ioo,joo)=((ox-xx*sx)*dy-(oy-yy*sy)*dx)*sz*half c GIAO like r x rj /2 b6(23,ioo,joo)=(oy*zj*sz-oz*yj*sy)*sx*half b6(24,ioo,joo)=(oz*xj*sx-ox*zj*sz)*sy*half b6(25,ioo,joo)=(ox*yj*sy-oy*xj*sx)*sz*half c GIAO like r x ri /2 b6(26,ioo,joo)=(oy*zi*sz-oz*yi*sy)*sx*half b6(27,ioo,joo)=(oz*xi*sx-ox*zi*sz)*sy*half b6(28,ioo,joo)=(ox*yi*sy-oy*xi*sx)*sz*half do 71 k=1,n1e 71 b6(k,ioo,joo)=b6(k,ioo,joo)*coe c if(npi.ne.npii.or.npjj.ne.npj)then do 74 ioo=1,npii do 74 joo=1,npjj ioj=joo+jo do 74 ipp=1,npi aiii=aai(ioo,ipp) if(aiii.ne.0.0d0)then do 741 jpp=1,npj ajjj=aaj(joo,jpp)*aiii do 741 k=1,n1e 741 sv(k,ioo,ioj)=sv(k,ioo,ioj)+ajjj*b6(k,ipp,jpp) endif 74 continue else do 7 ioo=1,npi do 7 joo=1,npj ioj=joo+jo do 7 k=1,n1e 7 sv(k,ioo,ioj)=sv(k,ioo,ioj)+b6(k,ioo,joo) endif 777 if(ish(ja,jp+1).gt.ish(ja,jp)) jo=jo+npjj c 5 continue 4 continue C if(ish(ia,ip+1).gt.ish(ia,ip))then c if last primitive of the orbitals io+1 ... io+npii, then write them do 33 ii=1,npii iorb=ii+io write(33)(sv(1,ii,jj),jj=1,iorb) c c check the normalization condition - orbital iorb anorm=one/sqrt(sv(1,ii,iorb)) if(abs(anorm-one).gt.0.001D0)then write(6,*)anorm,iorb if(.not.lnno)call report('Non-normalized aos') endif if(lsprint)write(3,*)iorb,anorm do 331 kk=2,4 331 write(34)(sv(kk,ii,jj),jj=1,nao) do 332 kk=5,10 332 write(35)(sv(kk,ii,jj),jj=1,nao) do 333 kk=11,13 333 write(36)(sv(kk,ii,jj),jj=1,nao) do 334 kk=14,16 334 write(37)(sv(kk,ii,jj),jj=1,nao) do 335 kk=17,19 335 write(38)(sv(kk,ii,jj),jj=1,nao) do 336 kk=20,22 336 write(39)(sv(kk,ii,jj),jj=1,nao) do 337 kk=23,25 337 write(40)(sv(kk,ii,jj),jj=1,nao) do 338 kk=26,28 338 write(41)(sv(kk,ii,jj),jj=1,nao) 33 continue io=io+npii c c zero-out temporary buffer: do 9 ii=1,u0 do 9 jj=1,nao do 9 kk=1,n1e 9 sv(kk,ii,jj)=z0 endif 3 continue 2 continue do 11 kk=33,41 11 close(kk) c if(lsprint)then open(33,file='SAO.SCR',form='unformatted') do 34 i=1,nao 34 read(33)(s(i,j),j=1,i) do 35 i=1,nao do 35 j=1,i-1 35 s(j,i)=s(i,j) close(33) call wmtr(s,nao,nao,'Overlap matrix, AO',i0) endif c if(lpprint)call wff('P.SCR','Dipole, AO, P',nao,s) c if(lqprint)then open(33,file='Q.SCR',form='unformatted') do 41 i=1,nao read(33)(s(i,j),j=1,nao) read(33) read(33) read(33) read(33) 41 read(33) call wmtr(s,nao,nao,'Quadrupole Overlaps, AO, XX',ione) rewind 33 do 42 i=1,nao read(33) read(33)(s(i,j),j=1,nao) read(33) read(33) read(33) 42 read(33) call wmtr(s,nao,nao,'Quadrupole Overlaps, AO, XY',ione) rewind 33 do 43 i=1,nao read(33) read(33) read(33)(s(i,j),j=1,nao) read(33) read(33) 43 read(33) call wmtr(s,nao,nao,'Quadrupole Overlaps, AO, XZ',ione) rewind 33 do 44 i=1,nao read(33) read(33) read(33) read(33)(s(i,j),j=1,nao) read(33) 44 read(33) call wmtr(s,nao,nao,'Quadrupole Overlaps, AO, YY',ione) rewind 33 do 45 i=1,nao read(33) read(33) read(33) read(33) read(33)(s(i,j),j=1,nao) 45 read(33) call wmtr(s,nao,nao,'Quadrupole Overlaps, AO, YZ',ione) rewind 33 do 46 i=1,nao read(33) read(33) read(33) read(33) read(33) 46 read(33)(s(i,j),j=1,nao) call wmtr(s,nao,nao,'Quadrupole Overlaps, AO, ZZ',ione) close(33) endif c if(lvprint)then call wff('V.SCR','Dipole velocities, AO, M',nao,s) call wff('W.SCR','Angular GIAO w, AO, M',nao,s) call wff('T.SCR','Angular GIAO t, AO, M',nao,s) call wff('D.SCR','Angular GIAO d, AO, M',nao,s) call wff('E.SCR','Angular GIAO e, AO, M',nao,s) endif c if(llprint)call wff('L.SCR','Angular moment, AO, L',nao,s) c c write(6,*)' One electron integrals calculated by overlap6' return end c subroutine wff(s1,s2,nao,s) character*(*) s1,s2 integer*4 nao,i,j real*8 s(nao,nao) open(33,file=s1,form='unformatted') do 53 i=1,nao read(33)(s(i,j),j=1,nao) read(33) 53 read(33) call wmtr(s,nao,nao,s2//'X',1) rewind 33 do 54 i=1,nao read(33) read(33)(s(i,j),j=1,nao) 54 read(33) call wmtr(s,nao,nao,s2//'Y',1) rewind 33 do 55 i=1,nao read(33) read(33) 55 read(33)(s(i,j),j=1,nao) call wmtr(s,nao,nao,s2//'Z',1) close(33) return end subroutine makemos2(nao,cij,nmo,nproc) c transform dipole moments into MOs implicit real*8 (a-h,o-z) implicit integer*4 (i-n) parameter (nfiles=10) c nfiles c 1 P dipole c 2 Q quadrupole c 3 L magnetic r x grad / 2 c 4 V gradient c 5 W magnetic (r-rj) x grad / 2 c 6 T magnetic (r-rij) x grad / 2 c 7 U magnetic (r-rj) x grad / 2 * "pop" ab c 8 C magnetic (r-rij) x grad / 2* "pop" ab c 9 D GIAO like r x rj / 2 c 10 E GIAO like r x ri / 2 dimension bao(nao,nao),bmo(nao,nao), 1btem(nao,nao),cij(nao,nao) integer*4 id(nfiles) character*5 fn(nfiles) character*7 fm data id/3 ,6 ,3 ,3 ,3 , 1 3 ,3 ,3 ,3 ,3 / data fn/'P.SCR' ,'Q.SCR' ,'L.SCR' ,'V.SCR' ,'W.SCR' , 1 'T.SCR' ,'U.SCR' ,'C.SCR' ,'D.SCR' ,'E.SCR' / character*1 xyz(3) character*2 qxy(6) data xyz/'X','Y','Z'/ data qxy/'XX','XY','XZ','YY','YZ','ZZ'/ logical ltxt,lex ltxt=.true. c write(6,6000) 6000 format(/,' makemos2',/, 1 ' ^^^^^^^^') inquire(file='PX.MO.SCR.TXT',exist=lex) if(lex)then write(6,*)' PX.MO.SCR.TXT'//' exists, skipped' return endif do 8 if=1,nfiles c P and L only: if(if.eq.1.or.if.eq.3)then idim=id(if) fm=fn(if)(1:1)//'MO'//fn(if)(2:5) write(6,63737)fn(if),fm 63737 format(' Transforming ',a5,' to ',a7,'.') inquire(file=fn(if),exist=lex) if(lex)then open(33,file=fn(if),form='unformatted') open(37,file=fm,form='unformatted') do 7 ix=1,idim rewind 33 do 6 i=1,nao do 5 idu=1,ix-1 5 read(33) read(33)(bao(j,i),j=1,nao) do 6 idu=ix+1,idim 6 read(33) call taomo2(bao,bmo,cij,nao,nmo,btem,nproc) do 71 i=1,nmo 71 write(37)(bmo(j,i),j=1,nmo) if(ltxt)then if(idim.eq.3)then open(38,file=fn(if)(1:1)//xyz(ix)//'.MO.SCR.TXT') call wmtr38(38,bmo,nao,nmo,fn(if)(1:1)//xyz(ix)//' MO',1) write(6,*)fn(if)(1:1)//xyz(ix)//'.MO.SCR.TXT written' else open(38,file=fn(if)(1:1)//qxy(ix)//'.MO.SCR.TXT') call wmtr38(38,bmo,nao,nmo,fn(if)(1:1)//qxy(ix)//' MO',1) write(6,*)fn(if)(1:1)//qxy(ix)//'.MO.SCR.TXT written' endif close(38) endif 7 continue close(37) close(33) else write(6,*)fn(if)//' not found, skipped' endif endif 8 continue c return end subroutine wmtr38(io,A,n0,n,st,ic) c c number of the file c c ic=0 .. writes triangle of a supposedly symmetric matrix c ic=1 .. writes it all c IMPLICIT REAL*8(A-H,O-Z) IMPLICIT INTEGER*4 (I-N) dimension A(n0,n) character*(*) st write(io,*)st write(io,*) N1=1 1 N3=MIN(N1+4,N) WRITE(io,18)(I,I=N1,N3) 18 FORMAT(4X,5I14) lnst=N1 if(ic.eq.1)lnst=1 DO 130 LN=lnst,N IEND=MIN(LN,N3) if(ic.eq.1)iend=n3 130 WRITE(io,17)LN,(A(LN,J),J=N1,iend) N1=N1+5 IF(N3.LT.N)GOTO 1 17 FORMAT(I4,5D14.6) write(io,*) return end subroutine taomo2(buff,dr,cij,nao,nmo,btem,nproc) c transformation of any coef buff(AO)->dr(MO) implicit real*8(a-h,o-z) implicit integer*4(i-n) dimension buff(nao,nao),dr(nao,nao),cij(nao,nao), 1btem(nao,nao) data z0/0.0d0/ if(nproc.ne.0)call omp_set_num_threads(nproc) c C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(i,j,sum,ii) do 1 i=1,nmo do 11 j=1,nao sum=z0 do 2 ii=1,nao 2 sum=sum+cij(i,ii)*buff(ii,j) 11 btem(i,j)=sum 1 continue c C$OMP Parallel Do Schedule(Dynamic) Default(Shared) C$OMP+ Private(i,j,sum,jj) do 3 i=1,nmo do 31 j=1,nmo sum=z0 do 4 jj=1,nao 4 sum=sum+cij(j,jj)*btem(i,jj) 31 dr(i,j)=sum 3 continue return end c subroutine rmtr38(A,n0,n,ic) c ic=0 .. reads triangle of a supposedly symmetric matrix c ic=1 .. reads it all c IMPLICIT REAL*8(A-H,O-Z) IMPLICIT INTEGER*4 (I-N) dimension A(n0,n) read(38,*) read(38,*) N1=1 1 N3=MIN(N1+4,N) read(38,*) lnst=n1 if(ic.eq.1)lnst=1 DO 130 LN=lnst,N IEND=MIN(LN,N3) if(ic.eq.1)iend=N3 130 read(38,*)J,(A(LN,J),J=N1,iend) N1=N1+5 IF(N3.LT.N)GOTO 1 read(38,*) return end subroutine wmtr(A,n0,n,st,ic) c c ic=0 .. writes triangle of a supposedly symmetric matrix c ic=1 .. writes it all c IMPLICIT REAL*8(A-H,O-Z) IMPLICIT INTEGER*4 (I-N) dimension A(n0,n) character*(*) st write(3,*)st write(3,*) N1=1 1 N3=MIN(N1+4,N) WRITE(3,18)(I,I=N1,N3) 18 FORMAT(4X,5I14) lnst=n1 if(ic.eq.1)lnst=1 DO 130 LN=lnst,N IEND=MIN(LN,N3) if(ic.eq.1)iend=n3 130 WRITE(3,17)LN,(A(LN,J),J=N1,iend) N1=N1+5 IF(N3.LT.N)GOTO 1 17 FORMAT(I4,5D14.6) write(3,*) return end subroutine symmu(nao,er,ei,orb,dr,di) implicit none integer*4 nao,a,b real*8 er,ei,oo,orb(nao,nao),dr(nao,nao),di(nao,nao) er=0.0d0 ei=0.0d0 do 5 a=1,nao oo=orb(a,a) if(oo.ne.0.0d0)then er=er+dr(a,a)*oo ei=ei+di(a,a)*oo endif 5 continue do 52 a=1 ,nao do 52 b=a+1,nao oo=orb(a,b) if(oo.ne.0.0d0)then er=er+(dr(a,b)+dr(b,a))*oo ei=ei+(di(a,b)+di(b,a))*oo endif 52 continue return end subroutine wrpl(s,n1,n2,dv1,dv2,plane) implicit none character*(*) s integer*4 n1,n2,ix,iy real*8 plane(n1,n2),j1,j2,dv1,dv2 open(12,file=s) do 31 ix=1,n1 j1=dble(ix-1) do 31 iy=1,n2 j2=dble(iy-1) 31 write(12,1214)j1*dv1,j2*dv2,plane(ix,iy) 1214 format(3E13.5) close(12) return end SUBROUTINE INV(A,AI,N,TOL) IMPLICIT none integer*4 N,oo,ii,jj,iw,io,kk,i2,j2 REAL*8 TOL, A(N,N),AI(N,N),w real*8, allocatable ::E(:,:) allocate(E(N,2*N)) DO 1 ii=1,N DO 1 jj=1,N e(ii,jj)=a(ii,jj) E(II,JJ+N)=0.0D0 1 if (ii.EQ.jj)e(ii,jj+N)=1.0D0 DO 2 ii=1,N-1 iw=ii if (DABS(e(iw,iw)).LT.TOL) then DO 3 io=iw+1,N oo=IO if (io.GT.N)oo=io-N 3 if (DABS(e(oo,iw)).GE.TOL) goto 11 call report('Inverse cannot be done') 11 CONTINUE DO 4 kk=1, 2*N w=e(iw,kk) e(iw,kk)=e(oo,kk) 4 e(oo,kk)=w ENDIF DO 2 jj=ii+1,N DO 6 kk=ii+1, 2*N 6 e(jj,kk)=e(jj,kk)-e(ii,kk)*e(jj,ii)/e(ii,ii) 2 e(jj,ii)=0.0D0 DO 7 ii=1, N-1 i2=N-ii+1 DO 7 jj=1,i2-1 j2=i2-jj DO 9 kk=1, N 9 e(j2,kk+N)=e(j2,kk+N)-e(i2,kk+N)*e(j2,i2)/e(i2,i2) 7 e(j2,i2)=0.0D0 DO 10 ii=1,N DO 10 jj=1,N 10 AI(ii,jj)=e(ii,jj+N)/e(ii,ii) deallocate(E) RETURN END subroutine ll(n0,np,ic,X,Y,Z,W) 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 N integer*4 np,n0,ic,i,j,k real*8 X(*),Y(*),Z(*),W(*),tol,sum 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 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