******************************************************************************** * * * 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 ### wtdexch1 ### c c Writes exchange potentials as separate files c subroutine wtdexch1 (excp) implicit integer*4 (i-n) implicit real*8 (a-h,o-z) include 'commons8.inc' dimension excp(*) do iorb1=1,norb do iorb2=iorb1,norb k=i3xk(iorb1,iorb2) if (ilc(k).ne.0) then i3beg=i3b(k) irec=i3xrec1(k) ngrid=i3si(k) call wrec(irec,ngrid,excp(i3beg)) if (ilc(k).eq.2) then i3beg=i3b(k)+ngrid irec=i3xrec2(k) call wrec(irec,ngrid,excp(i3beg)) endif endif enddo enddo return 900 continue write(iout6,*) 'error detected when writing exchange', & ' potential',iorb1,iorb2,k,irec stop 'wtdexch1' 1050 format(/1x,'... writing functions to disk ...'//) 1070 format(//1x,'error! can not write data to disk'//) end