******************************************************************************** * * * 2DHF version 1-2003 * * Copyright (C) 1996 Jacek Kobus, Leif Laaksonen, Dage Sundholm * * * * This software may be used and distributed according to the terms * * of the GNU General Public License, see README and COPYING. * * * ******************************************************************************** c ### rfdexch ### c c Reads from a disk file exchange potentials involving orbital iorb c subroutine rfdexch (iorb1,excp) implicit integer*4 (i-n) implicit real*8 (a-h,o-z) include 'commons8.inc' dimension excp(*) idble=0 do iorb2=1,i3nexcp(iorb1) k=i3breck(iorb1,iorb2) i3beg=i3brec(iorb1,iorb2) if (ilc(k).eq.1) then i3b(k)=i3beg elseif (ilc(k).eq.2) then if (idble.eq.0) then i3b(k)=i3beg idble=1 else idble=0 endif endif irec=i3xpair(iorb1,iorb2) ngrid=i3si(k) call rrec(irec,ngrid,excp(i3beg)) enddo return 900 write(iout6,*) 'error detected when reading exchange', & ' potential',iorb1,iorb2,k,irec stop 'rfdexch' 1050 format(/1x,'... writing functions to disk ...'//) 1070 format(//1x,'error! can not write data to disk'//) end