3
3
$ oevals, evals, oirs, irs, oocc, occ)
5
* $Id: movecs_pr_anal.F,v 1.17 2008-11-26 17:07:09 bert Exp $
5
* $Id: movecs_pr_anal.F 21021 2011-08-24 23:42:21Z d3y133 $
8
8
#include "errquit.fh"
92
92
call util_print_centered(LuOut,title, 40, .true.)
98
98
call ga_get(g_vecs, 1, nbf, i, i, dbl_mb(k_vecs), 1)
133
if (abs(dbl_mb(k_vecs+int_mb(k_list+k))).lt.
134
$ abs(dbl_mb(k_vecs+int_mb(k_list+j)))) then
133
if ((abs(dbl_mb(k_vecs+int_mb(k_list+k)))*0.995.lt.
134
$ abs(dbl_mb(k_vecs+int_mb(k_list+j)))).and.
135
$ (abs(dbl_mb(k_vecs+int_mb(k_list+k)))*1.005.lt.
136
$ abs(dbl_mb(k_vecs+int_mb(k_list+j))))) then
135
137
m = int_mb(k_list+j)
136
138
int_mb(k_list+j) = int_mb(k_list+k)
137
139
int_mb(k_list+k) = m
140
elseif((abs(dbl_mb(k_vecs+int_mb(k_list+k)))*0.995.lt.
141
$ abs(dbl_mb(k_vecs+int_mb(k_list+j))))
143
$ (abs(dbl_mb(k_vecs+int_mb(k_list+k)))*1.005.lt.
144
$ abs(dbl_mb(k_vecs+int_mb(k_list+j))))) then
145
if (int_mb(k_list+j).lt.int_mb(k_list+k)) then
147
int_mb(k_list+j) = int_mb(k_list+k)
151
c the ordering is OK so do nothing
447
461
call ga_inquire(g_vecs, type, nbf, nmo)
448
if (.not. ga_create(mt_dbl, nbf, nbf, 'aomotmp',
449
$ 32,32,g_tmp1)) call errquit('xlm_ao_mo: tmp1',nbf*nbf,
462
if (.not. ga_create(mt_dbl, nbf, nbf, 'aomotmp',32,32,g_tmp1))
463
& call errquit('xlm_ao_mo: ga_create failed: g_tmp1',nbf*nbf,
451
if (.not. ga_create(mt_dbl, nbf, nmo, 'aomotmp2',
452
$ 32,32,g_tmp2)) call errquit('xlm_ao_mo: tmp2',nmo*nbf,
465
if (.not. ga_create(mt_dbl, nbf, nmo, 'aomotmp2',32,32,g_tmp2))
466
& call errquit('xlm_ao_mo: ga_create failed: g_tmp2',nmo*nbf,
454
468
if (.not. ma_push_get(mt_dbl,nbf,'xlmtpm',l_tmp, k_tmp))
455
$ call errquit('xlm_ao_mo: tmp', nbf, MA_ERR)
469
$ call errquit('xlm_ao_mo: ma_push_get failed: tmp',nbf,MA_ERR)
457
471
c Must transform the LHS index one mpole at a time so
458
472
c might as well do both at the same time since this will