      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'
      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
      SAVE PRTKEY, PRTKOM, PRTITL, I, DRC
      INTEGER PRTKOM, PRTITL, PRTKEY
      LOGICAL LARGE, DRC
      DATA ICALCN/0/
      IF (ICALCN.NE.NUMCAL) THEN
         ICALCN=NUMCAL
         IF( INDEX(KEYWRD,'RESTART').EQ.0.OR.INDEX(KEYWRD,'IRC=').NE.0)
     1THEN
            JLOOP=0
         ENDIF
         DO 10 I=80,1,-1
   10    IF(KEYWRD(I:I).NE.' ')GOTO 20
         I=1
   20    PRTKEY=I
         DO 30 I=80,1,-1
   30    IF(KOMENT(I:I).NE.' ')GOTO 40
         I=1
   40    PRTKOM=I
         DO 50 I=80,1,-1
   50    IF(TITLE(I:I).NE.' ')GOTO 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))
         ENDIF
      ENDIF
      IF(JLOOP.EQ.0.OR.(JLOOP/IPRINT)*IPRINT.EQ.JLOOP) THEN
         IF(DRC) THEN
            WRITE(6,'(//,'' FEMTOSECONDS  POINT  POTENTIAL +''
     1,'' KINETIC  =  TOTAL     ERROR    REF%   MOVEMENT'')')
         ELSE
            WRITE(6,'(//,''     POINT   POTENTIAL  +  ''
     1,''ENERGY LOST   =   TOTAL      ERROR    REF%   MOVEMENT'')')
         ENDIF
      ENDIF
      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(6,'(F10.3,I8,F12.5,F11.5,F11.5,
     1F10.5,'' '',I5,3X,''%'',A,A,I3)')TIME, ILOOP-2, ESCF, EKIN,
     2 ESCF+EKIN,ERRR,JLOOP,TEXT1,TEXT2,II
            WRITE(6,'(9X,A,F9.4,A)')' MOVEMENT FROM START =',XTOT,' ANGS
     1TROMS'
         ELSE
            WRITE(6,'(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(6,'(24X,'' INTEGRATED GRADIENT ERROR ='',G10.3,
C#     1'' KCALS/ANGSTROM'')')GTOT
            WRITE(6,'(9X,A,F9.4,A)')' MOVEMENT FROM START =',XTOT,' ANGS
     1TROMS'
         ENDIF
      ELSE
         IF(DRC) THEN
            IF(TEXT1.EQ.' '.AND.TEXT2.EQ.' ')THEN
               WRITE(6,'(F10.3,I8,F12.5,F11.5,F11.5,
     1F10.5,'' '',I5,3X,''%'',F8.4)')TIME, ILOOP-2, ESCF, EKIN,
     2 ESCF+EKIN,ERRR,JLOOP,XTOT
            ELSE
               WRITE(6,'(F10.3,I8,F12.5,F11.5,F11.5,
     1F10.5,'' '',I5,3X,''%'',A,A,I3)')TIME, ILOOP-2, ESCF, EKIN,
     2 ESCF+EKIN,ERRR,JLOOP,TEXT1,TEXT2
            ENDIF
         ELSE
            IF(TEXT1.EQ.' '.AND.TEXT2.EQ.' ')THEN
               WRITE(6,'(I8,F14.5,F13.5,F17.5,
     1F10.5,'' '',I5,3X,''%'',F8.4)') ILOOP-2, ESCF, EKIN,
     2 ESCF+EKIN,ERRR,JLOOP,XTOT
            ELSE
               WRITE(6,'(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
            ENDIF
         ENDIF
      ENDIF
      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(6,*)'                CARTESIAN GEOMETRY           '
     1//'VELOCITY (IN CM/SEC)'
         WRITE(6,*)'  ATOM        X          Y          Z'
     1      //'                X          Y          Z'
         DO 90 I=1,NUMAT
            LL=(I-1)*3+1
            LU=LL+2
            WRITE(6,'(I4,3X,A2,3F11.5,2X,3F11.1)')
     1I, ELEMNT(NAT(I)),(XYZ(J,I),J=1,3),(VEL(J,I),J=1,3)
   90    CONTINUE
      ENDIF
      IF((JLOOP/IPRINT)*IPRINT.EQ.JLOOP)THEN
         IVAR=1
         NA(1)=0
         L=0
         WRITE(6,'(//10X,''FINAL GEOMETRY OBTAINED'',33X,''CHARGE'')'
     1)
         WRITE(6,'(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
               GOTO 110
            ENDIF
            IF(I.LT.4) THEN
               IEL1(3)=0
               IF(I.LT.3) THEN
                  IEL1(2)=0
                  IF(I.LT.2) THEN
                     IEL1(1)=0
                  ENDIF
               ENDIF
            ENDIF
            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)*FRA
     1CT**2
               GG(2)=GEO3(1,I*3-1)+GEO3(2,I*3-1)*FRACT+GEO3(3,I*3-1)*FRA
     1CT**2
               GG(3)=GEO3(1,I*3  )+GEO3(2,I*3  )*FRACT+GEO3(3,I*3  )*FRA
     1CT**2
               WRITE(6,'(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(6,'(2X,A2,3(F12.6,I3),I4,2I3,13X,I5,A)')
     1    ELEMNT(LABELS(I)),(GG(K),IEL1(K),K=1,3),
     2NA(I),NB(I),NC(I),JLOOP,ALPHA//'%'
            ENDIF
  120    CONTINUE
         NA(1)=99
      ENDIF
      RETURN
      END
