      SUBROUTINE GEOUT(MODE1)
      implicit double precision (A-H,O-Z)
      include 'SIZES'
      include 'MOP6FILE'
**********************************************************************
*
*   GEOUT PRINTS THE CURRENT GEOMETRY.  IT CAN BE CALLED ANY TIME,
*         FROM ANY POINT IN THE PROGRAM AND DOES NOT AFFECT ANYTHING.
*
**********************************************************************
      common /GEOM  / GEO(3,NUMATM)
      common /GEOKST/ NATOMS,LABELS(NUMATM),
     1                NA(NUMATM),NB(NUMATM),NC(NUMATM)
      common /GEOVAR/ NVAR,LOC(2,MAXPAR),IDUMY,XPARAM(MAXPAR)
      common /PATH  / LATOM,LPARAM,REACT(200)
      common /DENSTY/ P(MPACK),PA(MPACK),PB(MPACK)
      common /CORE  / CORE(107)
      common /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
     1                NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
     2                NCLOSE,NOPEN,NDUMY,FRACT
      common /KEYWRD/ KEYWRD
      common /TITLES/ KOMENT,TITLE
      common /ATOMTX/ LTXT, TXTATM(NUMATM)
      common /GEOSYM/ NDEP,LOCPAR(MAXPAR),IDEPFN(MAXPAR),
     1                     LOCDEP(MAXPAR)
      common /ELEMTS/ ELEMNT(107)
      dimension COORD(3,NUMATM), Q2(NUMATM), LOCTMP(2,MAXPAR)
      character Q(3)*2, ELEMNT*2, FLAG1*2, FLAG0*2, FLAGN*2, TXTATM*8
      character KEYWRD*241, KOMENT*81, TITLE*81, BLANK*80, LTXT*1
      logical CART
      MODE=MODE1
      if (MODE.EQ.1) then
         FLAG1=' *'
         FLAG0='  '
         FLAGN=' +'
         IPRT=MIOB
      else
         FLAG1=' 1'
         FLAG0=' 0'
         FLAGN='-1'
         IPRT=ABS(MODE)
      end if
C
C *** OUTPUT THE PARAMETER DATA.
C
      CART=.FALSE.
      if (NA(1).NE.0) then
         CART=.TRUE.
         call XYZINT(GEO,NATOMS,NA,NB,NC,1.D0,COORD)
         LOCTMP(1,1)=2
         LOCTMP(2,1)=1
         LOCTMP(1,2)=3
         LOCTMP(2,2)=1
         LOCTMP(1,3)=3
         LOCTMP(2,3)=2
         NVARTM=0
         do 10 I=4,NATOMS
            NVARTM=NVARTM+3
            do 10 J=1,3
               LOCTMP(1,NVARTM+J)=I
   10    LOCTMP(2,NVARTM+J)=J
         NVARTM=NVARTM+3
      else
         do 20 I=1,NVAR
            LOCTMP(1,I)=LOC(1,I)
   20    LOCTMP(2,I)=LOC(2,I)
         NVARTM=NVAR
         do 30 J=1,3
C$DOUT VBEST
            do 30 I=1,NATOMS
   30    COORD(J,I)=GEO(J,I)
      end if
      DEGREE=57.29577951D00
      MAXTXT=ICHAR(LTXT)
      BLANK=' '
      if (MODE.EQ.1) then
         write(MIOB,40) BLANK(:MAX(2,MAXTXT-4)),
     %                  BLANK(:MAX(4,MAXTXT-2)),
     %                  BLANK(:MAX(18,MAXTXT+12))
   40    format(/4X,'ATOM',3X,'CHEMICAL',A ,'BOND LENGTH',4X,'BOND ANGL
     1E',4X ,' TWIST ANGLE',/3X,'NUMBER',2X,'SYMBOL', A,'(ANGSTROMS)',5
     2X,'(DEGREES)',5X,' (DEGREES)',/4X,'(I)',A,'NA:I',10X,'NB:NA:I',5
     3X,' NC:NB:NA:I',5X,'NA',3X,'NB',3X,'NC',/)
      else
         if (MODE.GT.0) call WRTTXT(IPRT)
      end if
      if (MODE.NE.1) then
         call CHRGE(P,Q2)
         do 50 I=1,NUMAT
            L=NAT(I)
   50    Q2(I)=CORE(L) - Q2(I)
      end if
      N=1
      IA=LOCTMP(1,1)
      II=0
      do 80 I=1,NATOMS
         do 60 J=1,3
            Q(J)=FLAG0
            if (IA.NE.I) go to 60
            if (J.NE.LOCTMP(2,N).OR.N.GT.NVARTM) go to 60
            Q(J)=FLAG1
            N=N+1
            IA=LOCTMP(1,N)
   60    continue
         W = COORD(2,I) * DEGREE
         X = COORD(3,I) * DEGREE
C
C  CONSTRAIN ANGLE TO DOMAIN 0 - 180 DEGREES
C
         W=W - AINT(W/360.D0)*360.D0
         if (W.LT.0) W=W+360.D0
         if (W .GT. 180.D0) then
            X=X+180.D0
            W=360.D0-W
         end if
C
C  CONSTRAIN DIHEDRAL TO DOMAIN -180 - 180 DEGREES
C
         X=X - AINT(X/360.D0+SIGN(0.5D0-1.D-9,X)-1.D-9)*360.D0
         if (LATOM.NE.I) go to 70
         J=LPARAM
         Q(J)=FLAGN
   70    continue
         BLANK=ELEMNT(LABELS(I))//TXTATM(I)//'  '
         if (MODE.NE.1) then
            J=MAX(4,MAXTXT+2)
            K=MAX(0,8-J)
         else
            J=MAX(9,MAXTXT+3)
         end if
         if (LABELS(I).NE.0) then
            if (MODE.NE.1) then
               if (LABELS(I).NE.99.AND.LABELS(I).NE.107) then
                  II=II+1
                  write(IPRT,'(1X,A,F11.7,1X,A2,F14.6,1X,A2,F14.6,1X,
     1A2,3I5,A,F7.4)') BLANK(:J),COORD(1,I),Q(1),W,Q(2),X,Q(3),
     2NA(I),NB(I),NC(I),BLANK(20:20+K),Q2(II)
               else
                  write(IPRT,'(1X,A,F11.7,1X,A2,F14.6,1X,A2,F14.6,1X,
     1A2,3I5)') BLANK(:J),COORD(1,I),Q(1),W,Q(2),X,Q(3),
     2NA(I),NB(I),NC(I)
               end if
            else if (I.GT.3) then
               write(MIOB,'(3X,I4 ,5X,A,F9.5,1X,A2,F14.5,1X,A2,F11.5,1X,
     %                     A2,I4,2I5)')
     %           I,BLANK(:J),COORD(1,I),Q(1),W,Q(2),X,Q(3),
     %             NA(I),NB(I),NC(I)
            else if (I.EQ.3) then
               write(MIOB,
     %            '(''      3'',5X,A,F9.5,1X,A2,F14.5,1X,A2,13X,2I5)')
     %                     BLANK(:J),COORD(1,3),Q(1),W,Q(2),NA(3),NB(3)
            else if (I.EQ.2) then
               write(MIOB,'(''      2'',5X,A,F9.5,1X,A2,30X,I5)')
     %                     BLANK(:J),COORD(1,2),Q(1),NA(2)
            else
               write(MIOB,'(''      1'',5X,A)') BLANK(:J)
            end if
         end if
   80 continue
      if (CART) NA(1)=99
      if (MODE.EQ.1) return
      write(IPRT,*)
      if (NDEP.EQ.0) return
C
C   OUTPUT SYMMETRY DATA.
C
      I=1
   90 J=I
  100 if (J.EQ.NDEP) go to 110
      if (LOCPAR(J).EQ.LOCPAR(J+1).AND.IDEPFN(J).EQ.IDEPFN(J+1)
     1                           .AND.J-I.LT.15) then
         J=J+1
         go to 100
      else
         write(IPRT,'(I4,I3,I5,15I4)')
     1              LOCPAR(I),IDEPFN(I),(LOCDEP(K),K=I,J)
      end if
      I=J+1
      go to 90
  110 continue
      write(IPRT,'(I4,I3,I5,15I4)')
     1LOCPAR(I),IDEPFN(I),(LOCDEP(K),K=I,J)
      return
      end
