      SUBROUTINE GEOUTG(IPRT)
      implicit double precision (A-H,O-Z)
      include 'SIZES'
      include 'MOP6FILE'
      common /GEOKST/ NATOMS,LABELS(NUMATM),
     1                NA(NUMATM),NB(NUMATM),NC(NUMATM)
      common /GEOVAR/ NVAR,LOC(2,MAXPAR),IDUMY,DUMY(MAXPAR)
      common /SIMBOL/ SIMBOL(MAXPAR)
      common /GEOSYM/ NDEP,LOCPAR(MAXPAR),IDEPFN(MAXPAR),LOCDEP(MAXPAR)
      common /ATOMTX/ LTXT, TXTATM(NUMATM)
      common /GEOM  / GEO(3,NUMATM)
************************************************************************
*
*   GEOUTG WRITES OUT THE GEOMETRY IN GAUSSIAN-8X STYLE
*
************************************************************************
      dimension IGEO(3,NUMATM)
      character LINE(3,NUMATM)*15, TYPE(3)*1, OPTDAT(MAXPAR)*14
      character TXTATM*8, BLANK*80, ELEMNT(107)*2, SIMBOL*10, LTXT*1
      data ELEMNT/' H','He',
     1 'Li','Be',' B',' C',' N',' O',' F','Ne',
     2 'Na','Mg','Al','Si',' P',' S','Cl','Ar',
     3 ' K','Ca','Sc','Ti',' V','Cr','Mn','Fe','Co','Ni','Cu',
     4 'Zn','Ga','Ge','As','Se','Br','Kr',
     5 'Rb','Sr',' Y','Zr','Nb','Mo','Tc','Ru','Rh','Pd','Ag',
     6 'Cd','In','Sn','Sb','Te',' I','Xe',
     7 'Cs','Ba','La','Ce','Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy',
     8 'Ho','Er','Tm','Yb','Lu','Hf','Ta',' W','Re','Os','Ir','Pt',
     9 'Au','Hg','Tl','Pb','Bi','Po','At','Rn',
     1 'Fr','Ra','Ac','Th','Pa',' U','Np','Pu','Am','Cm','Bk','Cf','XX',
     2 'Fm','Md','Cb','++',' +','--',' -','Tv'/
      data TYPE/'r','a','d'/
      do 10 I=1,NATOMS
         do 10 J=1,3
   10 IGEO(J,I)=-1
      do 20 I=1,NVAR
   20 IGEO(LOC(2,I),LOC(1,I))=-2
      do 30 I=1,NDEP
         if (IDEPFN(I).EQ.14) then
            IGEO(3,LOCDEP(I))=-LOCPAR(I)
         else
            if (IDEPFN(I).GT.3) go to 30
            IGEO(IDEPFN(I),LOCDEP(I))=LOCPAR(I)
         end if
   30 continue
      open(unit=MIOO,status='SCRATCH')
      DEGREE=90.D0/ASIN(1.D0)
      MAXTXT=ICHAR(LTXT)
      NOPT=0
      do 50 I=1,NATOMS
         do 40 J=1,3
            LINE(J,I)=' '
            if (IGEO(J,I).EQ.-1) then
               rewind MIOO
               if (J.NE.1) then
                  write(MIOO,'(F12.6)') GEO(J,I)*DEGREE
               else
                  write(MIOO,'(F12.6)') GEO(J,I)
               end if
               rewind MIOO
               READ(MIOO,'(A)') LINE(J,I)
            else if (IGEO(J,I).EQ.-2) then
               NOPT=NOPT+1
               if (SIMBOL(NOPT).NE.'---') then
               if (SIMBOL(NOPT) (1:1).EQ.'-') then
                 LINE(J,I) (4:)=SIMBOL(NOPT)(2:)
               else
                 LINE(J,I) (4:)=SIMBOL(NOPT)
               end if
               else
                  NBI=NB(I)
                  NCI=NC(I)
                  if (J.NE.3) NCI=0
                  if (J.EQ.1) NBI=0
                  call XXX(TYPE(J),I,NA(I),NBI,NCI,LINE(J,I) (4:))
               end if
               OPTDAT(NOPT)=LINE(J,I)
            else if (IGEO(J,I).LT.0) then
               LINE(3,I)=LINE(3,-IGEO(J,I))
               LINE(3,I) (3:3)='-'
            else
               LINE(J,I)=LINE(J,IGEO(J,I))
            end if
   40    continue
         BLANK=ELEMNT(LABELS(I))//TXTATM(I)//'  '
         if (LABELS(I).EQ.99) BLANK(1:1)=' '
         J=MAX(4,MAXTXT+2)
         if (I.EQ.1) then
            write(IPRT,'(1X,A,I4,A,I4,A,I4,A,I4)') BLANK(:J)
         else if (I.EQ.2) then
            write(IPRT,'(1X,A,I4,A,I4,A,I4,A,I4)')
     %                 BLANK(:J),NA(I),LINE(1,I)
         else if (I.EQ.3) then
            write(IPRT,'(1X,A,I4,A,I4,A,I4,A,I4)')
     %                 BLANK(:J),NA(I),LINE(1,I),NB(I), LINE(2,I)
         else
            L=0
            write(IPRT,'(1X,A,I4,A,I4,A,I4,A,I4)')
     %                 BLANK(:J),
     %                 NA(I),LINE(1,I),NB(I), LINE(2,I),
     %                 NC(I), LINE(3,I), L
         end if
   50 continue
      write(IPRT,*)
      do 70 L=1,3
         do 60 I=1,NOPT
            if (LOC(2,I).EQ.L) then
               if (LOC(2,I).NE.1) then
                  write(IPRT,'(A,F12.6)')
     %                       OPTDAT(I),GEO(LOC(2,I),LOC(1,I))*DEGREE
               else
                  write(IPRT,'(A,F12.6)')
     %                       OPTDAT(I),GEO(LOC(2,I),LOC(1,I))
               end if
            end if
   60    continue
   70 continue
      end
