program turbo
      character*80 filename,st
      character*2 shell
      character*1 sh
      parameter (ne0=10)
      real*8 c(ne0),e(ne0),ep(ne0)
c
      one=1.00
      z0=0.00
      write(6,*)' Re-writing Gaussian basis set into TURBOMOLE format'
      write(6,*)' Gaussian output with GFInput on:'
      read(5,'(a)')filename
      open(7,file=filename,status='old')
      open(8,file='TURBO.BAS')
      write(8,8)filename
8     format(A80)
      ii=0
1     read(7,8,end=900)st
c
      if(st(1:16).eq.' Standard basis:')then
       ii=ii+1
       write(6,*)st
       write(8,8)st
       do 2 i=1,3
2      read(7,8)st
777    shell=st(2:3)
       np=xs(st(4:7))
       sf=xs(st(8:12))
       if(abs(sf-one).ne.z0)then
        write(6,*)sf
        call report('SF <> 1 !!!')
       endif
       if(np.gt.ne0)call report('Too many primitives!')
       do 3 i=1,np
       if(shell.eq.'SP')then
        read(7,*)c(i),e(i),ep(i)
       else
        read(7,*)c(i),e(i)
       endif
3      continue  
       if(shell.eq.'S ')then
        sh='s'
       else
        if(shell.eq.'P ')then
         sh='p'
        else
         if(shell.eq.'D ')then
          sh='d'
         else
          if(shell.eq.'F ')then
           sh='f'
          else
           if(shell.eq.'SP')then
            sh='s'
           else
            call report('Unknown shell type')
           endif
          endif
         endif
        endif
       endif
       write(8,8001)np,sh
8001   format(i3,2x,a1)
       do 4 i=1,np
4      write(8,8002)c(i),e(i)
8002   format(2g18.8)
       if(shell.eq.'SP')then
        sh='p'
        write(8,8001)np,sh
        do 5 i=1,np
5       write(8,8002)c(i),ep(i)
       endif
       read(7,8)st
       if(st(1:5).ne.' ****')then
        goto 777
       else
        read(7,*,err=900,end=900)ic
        read(7,8)st
        goto 777
       endif
      endif
      goto 1
c
900   call report('File TURBO.BAS written OK.')
      end
     
      function xs(s)
      real xs
      character*(*) s
      rewind 9
      write(9,*)s
      rewind 9
      read(9,*)a
      xs=a
      return
      end
c
      subroutine report(s)
      character*(*) s
      write(6,*)s
      close(7)
      close(8)
      stop
      end