******************************************************************************** * * * 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 *** r_exponents *** c c Reads exponents and contraction coefficients from c a GAUSSSIAN94 output obtained with gfinput keyword c c Warning! c Basis functions of g, h and higher symmertries are not allowed c Uncontracted basis set must be used c subroutine r_exponents(ibc,ib,istop) implicit integer*4 (i-n) implicit real*8 (a-h,o-z) character*3 symlab include 'commons8.inc' parameter (maxbasis=_MAXBASIS_) parameter (maxcf=100) dimension expon(maxcf),dcoef(maxcf,4) istop=0 c read the centre number read(7,*,err=900) icent c read symmetry label and the number of exponents do i=1,maxbasis read(7,1000,err=904) symlab, ncf if (symlab.ne.' **') then if (ncf.gt.maxcf) then print *,'r_exponents: too many primitive functions per', & 'single contracted gaussian; increase maxcf' stop endif if (symlab.eq.' S ') then do j=1,ncf read(7,1010,end=950,err=904) expon(j),dcoef(j,1) enddo c define s-type gaussians ibc=ibc+1 do j=1,ncf ib=ib+1 if (ib.gt.maxbasis) goto 990 coeff(ib)=dcoef(j,1) primexp(ib)=expon(j) ixref(ib)=ibc lprim(ib)=0 mprim(ib)=0 enddo elseif (symlab.eq.' SP') then do j=1,ncf read(7,1010,end=950,err=904) expon(j),dcoef(j,1), & dcoef(j,2) enddo c define s-type gaussians ibc=ibc+1 do j=1,ncf ib=ib+1 if (ib.gt.maxbasis) goto 990 coeff(ib)=dcoef(j,1) primexp(ib)=expon(j) ixref(ib)=ibc lprim(ib)=0 mprim(ib)=0 enddo c define p-type orbitals (x,y,z) do k=1,3 ibc=ibc+1 do j=1,ncf ib=ib+1 if (ib.gt.maxbasis) goto 990 coeff(ib)=dcoef(j,2) primexp(ib)=expon(j) ixref(ib)=ibc lprim(ib)=1 if (k.eq.1) mprim(ib)=+1 if (k.eq.2) mprim(ib)=-1 if (k.eq.3) mprim(ib)= 0 enddo enddo elseif (symlab.eq.' P ') then do j=1,ncf read(7,1010,end=950,err=904) expon(j),dcoef(j,2) enddo c define p-type orbitals (x,y,z) do k=1,3 ibc=ibc+1 do j=1,ncf ib=ib+1 if (ib.gt.maxbasis) goto 990 coeff(ib)=dcoef(j,2) primexp(ib)=expon(j) ixref(ib)=ibc lprim(ib)=1 if (k.eq.1) mprim(ib)=+1 if (k.eq.2) mprim(ib)=-1 if (k.eq.3) mprim(ib)= 0 enddo enddo c define d-type orbitals (d0,d1,d-1,d2,d-2) elseif (symlab.eq.' D ') then do j=1,ncf read(7,1010,end=950,err=904) expon(j),dcoef(j,3) enddo do k=1,5 ibc=ibc+1 do j=1,ncf ib=ib+1 if (ib.gt.maxbasis) goto 990 coeff(ib)=dcoef(j,3) primexp(ib)=expon(j) ixref(ib)=ibc lprim(ib)=2 if (k.eq.1) mprim(ib)= 0 if (k.eq.2) mprim(ib)=+1 if (k.eq.3) mprim(ib)=-1 if (k.eq.4) mprim(ib)=+2 if (k.eq.5) mprim(ib)=-2 enddo enddo c define f-type orbitals (f0,f1,f-1,f2,f-2,f3,f-3)` elseif (symlab.eq.' F ') then do j=1,ncf read(7,1010,end=950,err=904) expon(j),dcoef(j,4) enddo do k=1,7 ibc=ibc+1 do j=1,ncf ib=ib+1 if (ib.gt.maxbasis) goto 990 coeff(ib)=dcoef(j,4) primexp(ib)=expon(j) ixref(ib)=ibc lprim(ib)=3 if (k.eq.1) mprim(ib)= 0 if (k.eq.2) mprim(ib)=+1 if (k.eq.3) mprim(ib)=-1 if (k.eq.4) mprim(ib)=+2 if (k.eq.5) mprim(ib)=-2 if (k.eq.6) mprim(ib)=+3 if (k.eq.7) mprim(ib)=-3 enddo enddo else print *,'r_exponents: symmetries g and higher are ', & 'not allowed' stop endif else istop=0 return endif enddo 00900 istop=1 return c 00904 print *,'r_exponents: error encountered when reading ', & 'gauss94.out' stop 00950 stop 'r_exponents: end of gauss94.out file encountered' 00990 stop 'r_exponents: too many basis functions; increase maxbasis' 01000 format(a3,2x,i2) 01010 format(2x,d16.10,2x,d16.10,2x,d16.10,2x) end