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


