******************************************************************************** * * * 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 ### rfun ### c c Reads functions from a disk file in an unformatted form c subroutine rfun (norbt,cw_orb,cw_coul,cw_exch) implicit integer*4 (i-n) implicit real*8 (a-h,o-z) character*15 csub character*75 cmess include 'commons8.inc' dimension cw_orb(*),cw_coul(*),cw_exch(*) dimension i1bt(60),i2bt(60),i3bt(1830), & i1et(60),i2et(60),i3et(1830), & i1sit(60),i2sit(60),i3sit(1830), & i1ngt(60),i2ngt(60),i3ngt(1830), & i1mut(60),i2mut(60),i3mut(1830) read (iinp11,err=1000) i1bt,i2bt,i3bt,i1et,i2et,i3et, & i1sit,i2sit,i3sit,i1ngt,i2ngt,i3ngt, & i1mut,i2mut,i3mut c retrieve orbitals ioffset=norb-norbt do i=1,norbt call reada(iinp11,i1si(i+ioffset),cw_orb(i1b(i+ioffset)),ierr) if (ierr.ne.0) then write(iout6,*) 'error detected when reading orbital',i stop 'rfun' endif enddo c retrieve the extra data from the orbital input file read(iinp11,end=1010,err=1010) area read(iinp11,end=1010,err=1010) eng read(iinp11,end=1010,err=1010) engo read(iinp11,end=1010,err=1010) cmulti read(iinp11,end=1010,err=1010) excdi read(iinp11,end=1010,err=1010) excqu read(iinp11,end=1010,err=1010) excoc read(iinp11,end=1010,err=1010) exche read(iinp11,end=1010,err=1010) exc5 read(iinp11,end=1010,err=1010) exc6 read(iinp11,end=1010,err=1010) exc7 read(iinp11,end=1010,err=1010) exc8 rewind iinp11 c read in Coulomb potentials do i=1,norbt call reada(iinp12,i2si(i+ioffset),cw_coul(i2b(i+ioffset)), & ierr) if (ierr.ne.0) then write(iout6,*) 'error detected when reading coulomb', & ' potential',i stop 'rfun' endif enddo rewind iinp12 c read in exchange potentials from the exhange potential input file c (only for HF calculations) if (imethod.eq.1) then if (iform.eq.1.or.iform.eq.3.and.ini.ne.6) then do iorb1=1,norbt do iorb2=iorb1,norbt k=iorb1+iorb2*(iorb2-1)/2 if (iorb1.eq.iorb2.and.ll(iorb1).eq.0) goto 50 call reada(iinp13,i3si(k),cw_exch(i3b(k)),ierr) if (ierr.ne.0) then write(iout6,*) 'error detected when reading ', & 'exchange potential',iorb1,iorb2,k c stop 'rfun' endif if (iorb1.eq.iorb2) goto 50 if (ll(iorb1).eq.0.or.ll(iorb2).eq.0) goto 50 call reada(iinp13,i3si(k),cw_exch(i3b(k)+i3si(k)), & ierr) if (ierr.ne.0) then write(iout6,*) 'error detected when reading ', & 'exchange potential',iorb1,iorb2,k c stop 'rfun' endif 50 continue enddo enddo rewind iinp13 endif write(*,*) '... orbitals and potentials have been ', & 'retrieved ... ' endif return 1000 continue write(*,*) '... error detected when retrieving the disk', & ' file ... ' stop 'rfun' 1010 write(*,*) '... error has been detected when retrieving ', & 'extension of the orbital input file ...' write(*,*) '... disk file without extension retrieved ... ' idump=1 1100 continue csub='rfun' if(idbg(59).ne.0) then write(*,*) 'rfdisk |||||||||||||||' c print orbitals and coulomb potentials do i=1,norb cmess='orbital ' write(*,*) 'rfdisk: ',iorn(i),' ',bond(i) call pmtx(nni,i1mu(i),cw_orb(i1b(i)),1,1,incrni,incrmu) enddo stop do i=1,norb cmess='Coulomb potential ' call dbgp (59,csub,cmess,cw_coul(i2b(i)),nni,i2mu(i)) enddo c print exchange potentials cmess='exchange potential ' do i=1,nexch call dbgp (59,csub,cmess,cw_exch(i3b(i)),nni,i3mu(i)) enddo endif return end