********************************************************************************
*                                                                              * 
*  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

