********************************************************************************
*                                                                              * 
*  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 ### wtdexch ###
c
c     Writes exchange potentials involving orbital iorb as separate files 
c
      subroutine wtdexch (iorb1,excp)
      implicit integer*4 (i-n)
      implicit real*8 (a-h,o-z)
      include 'commons8.inc'
      dimension excp(*)

      do iorb2=1,i3nexcp(iorb1)
         k=i3breck(iorb1,iorb2)
         itemp=iwexch(k)
         if (iwexch(k).ne.0) then
            if (iwexch(k).eq.-1) iwexch(k)= 0
            if (iwexch(k).eq.-2) iwexch(k)=-1
            i3beg=i3brec(iorb1,iorb2)
            irec=i3xpair(iorb1,iorb2)
            ngrid=i3si(k) 
            call wrec(irec,ngrid,excp(i3beg))
         endif
      enddo

      return
      end
