      SUBROUTINE DRCOUT(XYZ3,GEO3,VEL3,NVAR,TIME,ESCF3,EKIN3,
     1GTOT3,ETOT3,XTOT3,ILOOP,CHARGE,FRACT,TEXT1,TEXT2,II,JLOOP)
      implicit double precision (A-H,O-Z)
      include 'SIZES'
      include 'MOP6FILE'
      character TEXT1*3,TEXT2*2
      dimension XYZ3(3,NVAR), VEL3(3,NVAR), ESCF3(3), EKIN3(3)
      dimension XYZ(3,NUMATM), VEL(3,NUMATM), CHARGE(NUMATM),
     1 GEO3(3,NUMATM), ETOT3(3), GTOT3(3), XTOT3(3)
*************************************************************
*                                                           *
*    DRCOUT PRINTS THE GEOMETRY, ETC. FOR A DRC AT A        *
*    POSITION DETERMINED BY FRACT.                          *
*    ON INPUT XYZ3  = QUADRATIC EXPRESSION FOR THE GEOMETRY *
*             VEL3  = QUADRATIC EXPRESSION FOR THE VELOCITY *
*             ESCF3 = QUADRATIC EXPRESSION FOR THE P.E.     *
*             EKIN3 = QUADRATIC EXPRESSION FOR THE K.E.     *
*                                                           *
*************************************************************
      common /KEYWRD/ KEYWRD
      common /GEOKST/ NATOMS,LABELS(NUMATM),
     1                NA(NUMATM),NB(NUMATM),NC(NUMATM)
      common /ELEMTS/ ELEMNT(107)
      common /GEOVAR/ IIVAR, LOC(2,MAXPAR), IDUMY, XPARAM(MAXPAR)
      common /TITLES/ KOMENT,TITLE
      common /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
     1                NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
     2                NCLOSE,NOPEN,NDUMY,XRACT
      common /NUMCAL/ NUMCAL
      dimension  IEL1(3), GG(3)
      character KEYWRD*241,KOMENT*81,TITLE*81, ALPHA*2, ELEMNT*2
      INTEGER PRTKOM, PRTITL, PRTKEY
      logical LARGE, DRC
      save PRTKEY, PRTKOM, PRTITL, I, DRC
      data ICALCN/0/
      if (ICALCN.NE.NUMCAL) then
         ICALCN=NUMCAL
         if (INDEX(KEYWRD,'RESTART').EQ.0 .OR.
     1      INDEX(KEYWRD,'IRC=').NE.0)          then
            JLOOP=0
         end if
         do 10 I=80,1,-1
   10    if (KEYWRD(I:I).NE.' ') go to 20
         I=1
   20    PRTKEY=I
         do 30 I=80,1,-1
   30    if (KOMENT(I:I).NE.' ') go to 40
         I=1
   40    PRTKOM=I
         do 50 I=80,1,-1
   50    if (TITLE(I:I).NE.' ') go to 60
         I=1
   60    PRTITL=I
         DRC=(INDEX(KEYWRD,'DRC').NE.0)
         I=INDEX(KEYWRD,'LARGE')
         IPRINT=10000
         if (I.NE.0) then
            IPRINT=1
            I=I+5
            LARGE=(KEYWRD(I:I).EQ.' '.OR.KEYWRD(I+1:I+1).EQ.'-')
            if (KEYWRD(I:I).EQ.'=') IPRINT=ABS(READA(KEYWRD,I))
         end if
      end if
      if (JLOOP.EQ.0.OR.(JLOOP/IPRINT)*IPRINT.EQ.JLOOP) then
         if (DRC) then
            write(MIOB,'(//,'' FEMTOSECONDS  POINT  POTENTIAL +''
     1,'' KINETIC  =  TOTAL     ERROR    REF%   MOVEMENT'')')
         else
            write(MIOB,'(//,''     POINT   POTENTIAL  +  ''
     1,''ENERGY LOST   =   TOTAL      ERROR    REF%   MOVEMENT'')')
         end if
      end if
      JLOOP=JLOOP+1
C#      FRACT=0.D0
      ESCF=ESCF3(1)+ESCF3(2)*FRACT+ESCF3(3)*FRACT**2
      EKIN=EKIN3(1)+EKIN3(2)*FRACT+EKIN3(3)*FRACT**2
      ETOT=ETOT3(1)+ETOT3(2)*FRACT+ETOT3(3)*FRACT**2
      GTOT=GTOT3(1)+GTOT3(2)*FRACT+GTOT3(3)*FRACT**2
      XTOT=XTOT3(1)+XTOT3(2)*FRACT+XTOT3(3)*FRACT**2
      ERRR=MIN(9999.99999D0,MAX(-999.99999D0,ESCF+EKIN-ETOT))
      if (II.NE.0) then
         if (DRC) then
            write(MIOB,'(F10.3,I8,F12.5,F11.5,F11.5,
     1                   F10.5,'' '',I5,3X,''%'',A,A,I3)')
     2   TIME, ILOOP-2, ESCF, EKIN, ESCF+EKIN,ERRR,JLOOP,TEXT1,TEXT2,II
            write(MIOB,'(9X,A,F9.4,A)')
     %        ' MOVEMENT FROM START =',XTOT,' ANGSTROMS'
         else
            write(MIOB,'(I8,F14.5,F13.5,F17.5,
     1F10.5,'' '',I5,3X,''%'',A,A,I3)') ILOOP-2, ESCF, EKIN,
     2 ESCF+EKIN,ERRR,JLOOP,TEXT1,TEXT2,II
C#      write(MIOB,'(24X,'' INTEGRATED GRADIENT ERROR ='',G10.3,
C#     1'' KCALS/ANGSTROM'')')  GTOT
            write(MIOB,'(9X,A,F9.4,A)')
     %               ' MOVEMENT FROM START =',XTOT,' ANGSTROMS'
         end if
      else
         if (DRC) then
            if (TEXT1.EQ.' '.AND.TEXT2.EQ.' ') then
               write(MIOB,'(F10.3,I8,F12.5,F11.5,F11.5,
     1                      F10.5,'' '',I5,3X,''%'',F8.4)')
     2 TIME, ILOOP-2, ESCF, EKIN,ESCF+EKIN,ERRR,JLOOP,XTOT
            else
               write(MIOB,'(F10.3,I8,F12.5,F11.5,F11.5,
     1                      F10.5,'' '',I5,3X,''%'',A,A,I3)')
     2 TIME, ILOOP-2, ESCF, EKIN, ESCF+EKIN, ERRR, JLOOP, TEXT1, TEXT2
            end if
         else
            if (TEXT1.EQ.' '.AND.TEXT2.EQ.' ') then
               write(MIOB,'(I8,F14.5,F13.5,F17.5,
     1                      F10.5,'' '',I5,3X,''%'',F8.4)')
     2 ILOOP-2, ESCF, EKIN, ESCF+EKIN, ERRR, JLOOP, XTOT
            else
               write(MIOB,'(I8,F14.5,F13.5,F17.5,
     1                      F10.5,'' '',I5,3X,''%'',A,A,I3)')
     2 ILOOP-2, ESCF, EKIN, ESCF+EKIN, ERRR, JLOOP, TEXT1, TEXT2
            end if
         end if
      end if
      NATOMS=NVAR/3
      L=0
      do 80 I=1,NATOMS
         do 70 J=1,3
            L=L+1
            VEL(J,I)=VEL3(1,L)+VEL3(2,L)*FRACT+VEL3(3,L)*FRACT**2
   70    XYZ(J,I)=XYZ3(1,L)+XYZ3(2,L)*FRACT+XYZ3(3,L)*FRACT**2
   80 continue
      if (LARGE.AND.(JLOOP/IPRINT)*IPRINT.EQ.JLOOP) then
         write(MIOB,*)'                CARTESIAN GEOMETRY           '
     1              //'VELOCITY (IN CM/SEC)'
         write(MIOB,*)'  ATOM        X          Y          Z'
     1              //'                X          Y          Z'
         do 90 I=1,NUMAT
            LL=(I-1)*3+1
            LU=LL+2
            write(MIOB,'(I4,3X,A2,3F11.5,2X,3F11.1)')
     1           I, ELEMNT(NAT(I)),(XYZ(J,I),J=1,3),(VEL(J,I),J=1,3)
   90    continue
      end if
      if ((JLOOP/IPRINT)*IPRINT.EQ.JLOOP) then
         IVAR=1
         NA(1)=0
         L=0
         write(MIOB,
     %          '(//10X,''FINAL GEOMETRY OBTAINED'',33X,''CHARGE'')')
         write(MIOB,'(A)')
     %                 KEYWRD(:PRTKEY),KOMENT(:PRTKOM),TITLE(:PRTITL)
         LMAX=L
         L=0
         do 120 I=1,NUMAT
            J=I/26
            ALPHA(1:1)=CHAR(ICHAR('A')+J)
            J=I-J*26
            ALPHA(2:2)=CHAR(ICHAR('A')+J-1)
C$DOIT ASIS
            do 100 J=1,3
  100       IEL1(J)=0
  110       continue
            if (LOC(1,IVAR).EQ.I) then
               IEL1(LOC(2,IVAR))=1
               IVAR=IVAR+1
               go to 110
            end if
            if (I.LT.4) then
               IEL1(3)=0
               if (I.LT.3) then
                  IEL1(2)=0
                  if (I.LT.2) then
                     IEL1(1)=0
                  end if
               end if
            end if
            if (LABELS(I).LT.99) then
               L=L+1
               GG(1)=GEO3(1,I*3-2)+GEO3(2,I*3-2)*FRACT+GEO3(3,I*3-2)*
     1                             FRACT**2
               GG(2)=GEO3(1,I*3-1)+GEO3(2,I*3-1)*FRACT+GEO3(3,I*3-1)*
     1                             FRACT**2
               GG(3)=GEO3(1,I*3  )+GEO3(2,I*3  )*FRACT+GEO3(3,I*3  )*
     1                             FRACT**2
               write(MIOB,'(2X,A2,3(F12.6,I3),I4,2I3,F13.4,I5,A)')
     1                    ELEMNT(LABELS(I)),(GG(K),IEL1(K),K=1,3),
     2                    NA(I),NB(I),NC(I),CHARGE(L),JLOOP,ALPHA//'*'
            else
               write(MIOB,'(2X,A2,3(F12.6,I3),I4,2I3,13X,I5,A)')
     1                    ELEMNT(LABELS(I)),(GG(K),IEL1(K),K=1,3),
     2                    NA(I),NB(I),NC(I),JLOOP,ALPHA//'%'
            end if
  120    continue
         NA(1)=99
      end if
      return
      end
