
C FLUSHES BUFFERS AND WRITES OUT COMMON BLOCK INFORMATION
C FOR THE NEXT PROGRAM. SHOULD NEVER BE CALLED EXPLICITLY,
C AND IS A DEPENDENT OF CRAPSO.

      SUBROUTINE TERMIO
      IMPLICIT INTEGER (A-Z)
      DOUBLE PRECISION BUFFRC
      LOGICAL YESNO
      COMMON /FLAGS/ IFLAGS(100)
      INTEGER USEC,USECIN,TSTART,WSTART,FILE
      COMMON / / ICORE(1)
      COMMON /INCORE/ ICREC(2),USEC,IXT(2),IMOD(2)
      COMMON /MACHSP/ IINTLN,IFLTLN,IINTFP,IALONE,IBITWD
      COMMON /MACHSP2/MASK1,MASK2,ISHFSZ
      COMMON /FILES/ LUOUT,MOINTS
      COMMON /FILSPC/ ILNBUF,IPRCLN,IPRCWD
      COMMON /IOSTAT/ NOPBUF,NOPDSK
      COMMON /LISTS/ MOIO(10,500),MOIOWD(10,500),MOIOSZ(10,500),
     &               MOIODS(10,500),MOIOFL(10,500)
      COMMON /SYMPOP/ IRPDPD(8,22),ISYTYP(2,500),NTOT(18)
      COMMON /IOPOS/ ICRSIZ,ICHCSZ,IOFF(2),LENREC
      COMMON /CACHEINF/ CACHNUM,CACHNMP1,CACHDIR(100),CACHPOS(100),
     &                  CACHFILE(100),CACHMOD(100),OLDEST
      common/io_ptrs/TOTREC(5),TOTWRD(5)
#include "bwcc.com"

      IPACK(I,J)=IOR(J,ISHFT(I-49,ISHFSZ))
      UPACKR(I) =IAND(I,MASK1)
      UPACKF(I) =IAND(ISHFT(I,-ISHFSZ),MASK2)+49

c ----------------------------------------------------------------------

      MOIOSIZ=5000

c   o DUMP CACHES
cjp replace this with call to aces_cache_flush, which also zeroes out the buffer
cjp and make thus crapso more times callable, which is useful for
cjp multireference case
cjp - old
cjp      DO I=1,CACHNUM
cjp       FILE=CACHFILE(I)
cjp       IF(FILE.NE.0)THEN
cjp        RECORD=UPACKR(CACHDIR(I))
cjp        IPOS  =CACHPOS(I)
cjp        CALL ACES_IO_WRITE(FILE,RECORD,ICORE(IPOS),LENREC)
cjp        CACHMOD(I)=0
cjp       ENDIF
cjp      END DO
cjp - new
      call aces_cache_flush
cjp - end

c   o DUMP INFORMATION TO JOBARC
      CALL PUTREC(20,'JOBARC','MOIOVEC ',MOIOSIZ,MOIO)
      CALL PUTREC(20,'JOBARC','MOIOWRD ',MOIOSIZ,MOIOWD)
      CALL PUTREC(20,'JOBARC','MOIOSIZ ',MOIOSIZ,MOIOSZ)
      CALL PUTREC(20,'JOBARC','MOIODIS ',MOIOSIZ,MOIODS)
      CALL PUTREC(20,'JOBARC','MOIOFIL ',MOIOSIZ,MOIOFL)
      CALL PUTREC(20,'JOBARC','ISYMTYP ',1000,ISYTYP)
c      CALL UPDMOI(0,0,0,0,2,0)
      CALL PUTREC(20,'JOBARC','TOTRECMO',5,TOTREC)
      CALL PUTREC(20,'JOBARC','TOTWRDMO',5,TOTWRD)

c Nevin - changed exist to opened
      DO I = 50, 54
         INQUIRE(UNIT=I,opened=YESNO)
         IF (YESNO) CLOSE(I,STATUS='KEEP')
      END DO

      RETURN
      END

