[Wien] Fock exchange calculation
Peter Blaha
pblaha at theochem.tuwien.ac.at
Wed Oct 3 13:26:12 CEST 2007
Sorry, I attached a wrong version!
Hopefully, now it is ok.
Peter Blaha schrieb:
> We could verify the problem (occurs also in LDA+U) for an L=0 or 1 channel.
> (It is present only in the last release, since horb.F was heavily
> rewritten).
>
> The fix is simple in make_albl and ensures that the besselfunction
> arrays are
> allocated with at least 2 (and sphbes is called with min l=2).
>
> This subroutine is attached.
>
> Regards
>
> Natalie Holzwarth schrieb:
>> Dear WIEN2k developers,
>> We are trying to run an example with the Fock exchange within a
>> muffin tin sphere within an l=1 channel. In our case atom #3 is O
>> and we
>> wanted to estimate the Fock exhange contribution for the 2p states. The
>> case.ineece file is:
>> ----------------------------------------
>> -9.0 1 emin natom
>> 3 1 1 iatom nlorb lorb
>> EECE HYBR / EECE mode
>> 1.00 amount of exact exchange
>> ----------------------------------------
>> The first iteration runs correctly, but the second iteration fails during
>> the lapw1 step within the subroutine horb at the line
>>
>> call make_albl(jneq,r(jneq),lvor,NV,'ORB',1,0)
>>
>> Before investing more time in trying to trace the error, I thought I
>> should ask whether the program has been designed only for l>=2
>> corrections. (We are able to run an example for l=2 without any obvious
>> problems.) Thanks in advance for your advice,
>> Natalie Holzwarth
>>
>>
>>
>>
>> N. A. W. Holzwarth email: natalie at wfu.edu
>> Department of Physics www: http://www.wfu.edu/~natalie
>> Wake Forest University voice: 336-758-5510
>> Winston-Salem, NC 27109-7507 fax: 336-758-6142
>> U. S. A.
>> _______________________________________________
>> Wien mailing list
>> Wien at zeus.theochem.tuwien.ac.at
>> http://zeus.theochem.tuwien.ac.at/mailman/listinfo/wien
>
>
> ------------------------------------------------------------------------
>
> subroutine make_albl(jneq,r,ltop,NV,sub,imin,imax)
>
> use atspdt, only : P,DP,PE, DPE
> use albl
> use matrices, only : RK
> use lolog, only : lapw
> use parallel, only: LDHS, LCOLHS,nprow,myrowhs,npcol,mycolhs,blocksize
>
> INCLUDE 'param.inc'
>
> character sub*3
> integer jneq, ltop, nv, imin, imax
> real*8 r
>
> real*8 rkn
> integer N,nv_local,j,ipr,ipc
> integer iset,ihelp,myid_iset,npe_iset,i
>
> DOUBLE PRECISION, allocatable :: DFJ(:), FJ(:)
>
>
> allocate( DFJ(0:ltop), FJ(0:ltop) )
>
> if (sub.eq.'HAM') then
>
> #ifdef Parallel
>
> j=0
> DO N = 1, NV
> ipr=mod((N-1)/blocksize,nprow)
> if (ipr.ne.myrowhs) cycle
> j=j+1
> RKN = RK(N)
> CALL SPHBES(ltop,R*RKN,FJ)
> CALL DVBES1(FJ,DFJ,RKN,R,ltop+1)
> DO L = 0, ltop
> if(lapw(l,jneq)) then
> AL_r(j,L) = RKN*DFJ(L)*PE(L+1,JNEQ) - FJ(L)*DPE(L+1,JNEQ)
> BL_r(j,L) = FJ(L)*DP(L+1,JNEQ) - RKN*DFJ(L)*P(L+1,JNEQ)
> else
> AL_r(j,L) = FJ(L)/P(L+1,JNEQ)/R**2
> BL_r(j,L) = 0.0d0
> endif
> enddo
> enddo
>
> j=0
> do N=imin,imax
> j=j+1
> RKN = RK(N)
> CALL SPHBES(ltop,R*RKN,FJ)
> CALL DVBES1(FJ,DFJ,RKN,R,ltop+1)
> DO L = 0, ltop
> if(lapw(l,jneq)) then
> AL_c(j,L) = RKN*DFJ(L)*PE(L+1,JNEQ) - FJ(L)*DPE(L+1,JNEQ)
> BL_c(j,L) = FJ(L)*DP(L+1,JNEQ) - RKN*DFJ(L)*P(L+1,JNEQ)
> else
> AL_c(j,L) = FJ(L)/P(L+1,JNEQ)/R**2
> BL_c(j,L) = 0.0d0
> endif
> enddo
> enddo
>
> #else
>
> DO N = 1, NV
> RKN = RK(N)
> CALL SPHBES(ltop,R*RKN,FJ)
> CALL DVBES1(FJ,DFJ,RKN,R,ltop+1)
> DO L = 0, ltop
> if(lapw(l,jneq)) then
> AL_r(N,L) = RKN*DFJ(L)*PE(L+1,JNEQ) - FJ(L)*DPE(L+1,JNEQ)
> BL_r(N,L) = FJ(L)*DP(L+1,JNEQ) - RKN*DFJ(L)*P(L+1,JNEQ)
> else
> AL_r(N,L) = FJ(L)/P(L+1,JNEQ)/R**2
> BL_r(N,L) = 0.0d0
> endif
> enddo
> enddo
> j=0
> do N=imin,imax
> j=j+1
> AL_c(j,:)=AL_r(N,:)
> BL_c(j,:)=BL_r(N,:)
> enddo
>
> #endif
>
> else
>
> #ifdef Parallel
> iset_end=2
> #else
> iset_end=1
> #endif
> do iset=1,iset_end
>
> if (iset.eq.1) then
> npe_iset=npcol
> myid_iset=mycolhs
> else
> npe_iset=nprow
> myid_iset=myrowhs
> endif
>
> j=0
> DO N = 1, NV
> ipr=mod((N-1)/blocksize,npe_iset)
> if (ipr.ne.myid_iset) cycle
> j=j+1
> RKN = RK(N)
> CALL SPHBES(ltop,R*RKN,FJ)
> CALL DVBES1(FJ,DFJ,RKN,R,ltop+1)
> DO L = 0, ltop
> if(lapw(l,jneq)) then
> AL(j,L,iset) = RKN*DFJ(L)*PE(L+1,JNEQ) - FJ(L)*DPE(L+1,JNEQ)
> BL(j,L,iset) = FJ(L)*DP(L+1,JNEQ) - RKN*DFJ(L)*P(L+1,JNEQ)
> else
> AL(j,L,iset) = FJ(L)/P(L+1,JNEQ)/R**2
> BL(j,L,iset) = 0.0d0
> endif
> enddo
> enddo
>
> enddo
>
> endif
>
> deallocate(dfj,fj)
>
> end subroutine make_albl
>
>
> ------------------------------------------------------------------------
>
> _______________________________________________
> Wien mailing list
> Wien at zeus.theochem.tuwien.ac.at
> http://zeus.theochem.tuwien.ac.at/mailman/listinfo/wien
--
P.Blaha
--------------------------------------------------------------------------
Peter BLAHA, Inst.f. Materials Chemistry, TU Vienna, A-1060 Vienna
Phone: +43-1-58801-15671 FAX: +43-1-58801-15698
Email: blaha at theochem.tuwien.ac.at WWW: http://info.tuwien.ac.at/theochem/
--------------------------------------------------------------------------
-------------- next part --------------
A non-text attachment was scrubbed...
Name: make_albl.F
Type: text/x-fortran
Size: 3611 bytes
Desc: not available
Url : http://zeus.theochem.tuwien.ac.at/pipermail/wien/attachments/20071003/de675438/make_albl.bin
More information about the Wien
mailing list