1c
2c $Id$
3c
4c This routine was essentially stolen from movecs_read, but only read
5c the eigenvalues.
6c
7      logical function moeig_read(filename, iset, evals )
8      implicit none
9#include "global.fh"
10#include "msgtypesf.h"
11#include "mafdecls.fh"
12#include "msgids.fh"
13#include "inp.fh"
14#include "util.fh"
15c
16      character*(*) filename
17      integer iset              ! No. (1,2) of set of vectors to read
18      double precision evals(*) ! Must be at least nbf long (not nmo)
19c
20      integer nsets             ! No. of sets of vectors
21      integer nbf               ! No. of functions in basis
22      integer nmo(2)            ! No. of vectors in each set
23      integer ok, jset, i, j
24      integer mitob1
25      integer unitno
26      parameter (unitno = 67)
27c
28      mitob1=MA_sizeof(MT_INT,1,MT_BYTE)
29      call ga_sync()
30      ok = 0
31      if (ga_nodeid() .eq. 0) then
32         open(unitno, status='old', form='unformatted', file=filename,
33     $        err=1000)
34c
35c     Skip over uninteresting bits of the header
36c
37         read(unitno, err=1001, end=1001) ! convergence info
38         read(unitno, err=1001, end=1001) ! scftype
39         read(unitno, err=1001, end=1001) ! lentit
40         read(unitno, err=1001, end=1001) ! title
41         read(unitno, err=1001, end=1001) ! lenbas
42         read(unitno, err=1001, end=1001) ! basis_name
43         read(unitno, err=1001, end=1001) nsets
44         read(unitno, err=1001, end=1001) nbf
45         read(unitno, err=1001, end=1001) (nmo(i),i=1,nsets)
46c
47c     Skip over unwanted sets
48c
49         do jset = 1, iset-1
50            read(unitno, err=1001, end=1001)
51            read(unitno, err=1001, end=1001)
52            do i = 1, nmo(jset)
53               read(unitno, err=1001, end=1001)
54            enddo
55         enddo
56         read(unitno, err=1001, end=1001) ! occ
57         read(unitno, err=1001, end=1001) (evals(j),j=1,nbf)
58         do i = 1, nmo(iset)
59             read(unitno, err=1001, end=1001)  ! movecs
60         enddo
61 9       close(unitno,err=1002)
62         ok = 1
63      endif
64c
65 10   continue
66      call ga_sync()
67      call ga_brdcst(Msg_Vec_Stat+MSGINT, ok, mitob1, 0) ! Propagate status
68      if (ok .eq. 1) then
69         call ga_brdcst(Msg_Vec_EVal+MSGDBL, evals,
70     $        MA_sizeof(MT_DBL,nbf,MT_BYTE), 0)
71      endif
72c
73      moeig_read = ok .eq. 1
74      if (ga_nodeid() .eq. 0 .and. moeig_read .and.
75     $     util_print('vectors i/o', print_default)) then
76         write(6,22) filename(1:inp_strlen(filename))
77 22      format(/' Read molecular orbitals from ',a/)
78         call util_flush(6)
79      endif
80      return
81c
82 1000 write(6,*) ' moeig_read: failed to open ',
83     $     filename(1:inp_strlen(filename))
84      call util_flush(6)
85      ok = 0
86      goto 10
87c
88 1001 write(6,*) ' moeig_read: failing reading from ',
89     $     filename(1:inp_strlen(filename))
90      call util_flush(6)
91      ok = 0
92      close(unitno,err=1002)
93      goto 10
94c
95 1002 write(6,*) ' moeig_read: failed to close',
96     $     filename(1:inp_strlen(filename))
97      call util_flush(6)
98      ok = 0
99      goto 10
100c
101      end
102