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