ps_savemos.src

      SUBROUTINE PS_SAVEMOS(COMMENT)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER (MXATM=2000, NMO=500)
      LOGICAL GOPARR,DSKWRK,MASWRK
      CHARACTER*(*) COMMENT
      COMMON /INFOA / NAT,ICH,MUL,NUM,NQMT,NE,NA,NB,                    &
     &                ZAN(MXATM),C(3,MXATM),IAN(MXATM)
      COMMON /IOFILE/ IR,IW,IP,IJK,IJKT,IDAF,NAV,IODA(950)
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      ALLOCATABLE :: VEC(:)
!
      ALLOCATE (VEC(NUM**2),STAT=IALLOC)
      IF (IALLOC.NE.0) THEN
        WRITE(IW,"('MEMORY ALLOCATION ERROR IN PS_SAVEMOS')")
        CALL ABRT
      END IF
!   15 are alpha-spin MOs
      CALL DAREAD(IDAF,IODA,VEC,NUM**2,15,0)
      IF (MASWRK) THEN
        WRITE (IW,"(//'PUNCHED ALPHA MOS: ',A/)") TRIM(COMMENT)
        WRITE (IP,"(//'ALPHA MOS: ',A/)") TRIM(COMMENT)
        WRITE (IP,"(' $VEC ')")
        CALL PUSQL(VEC,NUM,NUM,NUM)
        WRITE (IP,"(' $END ')")
      END IF
      DEALLOCATE (VEC)
      END SUBROUTINE PS_SAVEMOS