1      subroutine movecs_ecce_print_on()
2      implicit none
3#include "ceccemoprint.fh"
4      flag = .true.
5      end
6      subroutine movecs_ecce_print_off()
7      implicit none
8#include "ceccemoprint.fh"
9      flag = .false.
10      end
11      subroutine movecs_ecce(nbf, nmo, lo, hi, eval, occ, sym,
12     $     g_movecs, scftype, key)
13*
14* $Id$
15*
16      implicit none
17#include "errquit.fh"
18#include "global.fh"
19#include "mafdecls.fh"
20#include "inp.fh"
21#include "ceccemoprint.fh"
22      integer nbf               ! [input] no. of basis functions
23      integer nmo               ! [input] no. of MOs
24      integer lo, hi            ! [input] range of MOs to print
25      double precision eval(*)  ! [input] MO energies
26      double precision occ(*)   ! [input] MO occupation numbers
27      integer sym(*)            ! [input] MO symmetries
28      integer g_movecs          ! [input] GA with vectors
29      character*(*) scftype     ! [input] Type of SCF
30      character*(*) key         ! [input] Part of keyword for ECCE
31c
32c     Output all of the evals, occupation numbers and symmetries and a
33c     subset of the molecular orbitals to the ECCE print file.
34c
35c     The ECCE keywords are constructed as
36c
37c     <scftype> <key> <molecular orbitals>
38c     <scftype> <key> <molecular orbital energies>
39c     ...
40c
41c     scftype is presently either RHF, ROHF, UHF, DFT, or MCSCF.
42c
43c     Key should be blank for restricted spin methods or alpha
44c     or beta for unrestricted methods as appropriate.
45c
46c     This routine is temporarily being used to print ALL of the
47c     MOs to the ECCE file.  This is not suitable for large
48c     calculations which should just print frontier orbitals
49c
50      integer l_v, k_v, stat1, stat2, range(2), slen, klen
51      character*80 ceval, cocc, cvec, cran, csym
52c
53c     If ECCE is not printing then go home.  Note that only process
54c     zero will really know but only it is printing.
55c
56      stat1 = 0
57      call ecce_print_control(stat1, stat2) ! stat2 set to print status
58      stat1 = stat2
59      call ecce_print_control(stat1, stat2) ! restore previous setting
60      if (stat1 .ne. 1) return
61c
62      if (.not. flag) return    ! Control for geometry optimization
63c
64c     Get the MOs
65c
66      if (.not. ma_push_get(mt_dbl, (hi-lo+1)*nbf, 'moecce', l_v, k_v))
67     $     call errquit('movecs_ecce: insufficient memory',0, MA_ERR)
68      call ga_get(g_movecs, 1, nbf, lo, hi, dbl_mb(k_v), nbf)
69c
70c     Construct the names
71c
72      ceval = ' '
73      cocc  = ' '
74      cvec  = ' '
75      cran  = ' '
76      csym  = ' '
77      slen = inp_strlen(scftype)
78      klen = inp_strlen(key)
79      if (key .eq. ' ') then
80         write(ceval,'(a,1x,a)')
81     $      'molecular orbital energies',
82     &      scftype(1:slen)
83         write(cocc,'(a,1x,a)')
84     $       'molecular orbital occupations',
85     &       scftype(1:slen)
86         write(cvec,'(a,1x,a)')
87     $        'molecular orbital vectors',
88     &       scftype(1:slen)
89         write(cran,'(a,1x,a)')
90     $       'molecular orbital range',
91     &       scftype(1:slen)
92         write(csym,'(a,1x,a)')
93     $       'molecular orbital symmetries',
94     &       scftype(1:slen)
95      else
96         write(ceval,'(a,1x,a,1x,a)')
97     &      'molecular orbital energies',
98     &      scftype(1:slen),
99     $      key(1:klen)
100         write(cocc,'(a,1x,a,1x,a)')
101     &       'molecular orbital occupations',
102     &       scftype(1:slen),
103     $       key(1:klen)
104         write(cvec,'(a,1x,a,1x,a)')
105     &       'molecular orbital vectors',
106     &       scftype(1:slen),
107     $       key(1:klen)
108         write(cran,'(a,1x,a,1x,a)')
109     &       'molecular orbital range',
110     &       scftype(1:slen),
111     $       key(1:klen)
112         write(csym,'(a,1x,a,1x,a)')
113     &       'molecular orbital symmetries',
114     &       scftype(1:slen),
115     $       key(1:klen)
116      endif
117      range(1) = lo
118      range(2) = hi
119c
120      call ecce_print1(ceval, mt_dbl, eval, nmo)
121      call ecce_print1(cocc,  mt_dbl, occ,  nmo)
122      call ecce_print1(csym,  mt_int, sym,  nmo)
123      call ecce_print1(cran,  mt_int, range, 2)
124      call ecce_print2_dbl_tol(cvec,  dbl_mb(k_v), nbf, nbf, (hi-lo)+1,
125     $     1d-3)
126c
127      if (.not. ma_pop_stack(l_v)) call errquit
128     $     ('movecs_ecce: ma stack is corrupt', 0, MA_ERR)
129c
130      end
131