~ubuntu-branches/ubuntu/saucy/nwchem/saucy

« back to all changes in this revision

Viewing changes to src/ddscf/movecs_pr_anal.F

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Michael Banck, Daniel Leidert
  • Date: 2012-02-09 20:02:41 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20120209200241-jgk03qfsphal4ug2
Tags: 6.1-1
* New upstream release.

[ Michael Banck ]
* debian/patches/02_makefile_flags.patch: Updated.
* debian/patches/02_makefile_flags.patch: Use internal blas and lapack code.
* debian/patches/02_makefile_flags.patch: Define GCC4 for LINUX and LINUX64
  (Closes: #632611 and LP: #791308).
* debian/control (Build-Depends): Added openssh-client.
* debian/rules (USE_SCALAPACK, SCALAPACK): Removed variables (Closes:
  #654658).
* debian/rules (LIBDIR, USE_MPIF4, ARMCI_NETWORK): New variables.
* debian/TODO: New file.
* debian/control (Build-Depends): Removed libblas-dev, liblapack-dev and
  libscalapack-mpi-dev.
* debian/patches/04_show_testsuite_diff_output.patch: New patch, shows the
  diff output for failed tests.
* debian/patches/series: Adjusted.
* debian/testsuite: Optionally run all tests if "all" is passed as option.
* debian/rules: Run debian/testsuite with "all" if DEB_BUILD_OPTIONS
  contains "checkall".

[ Daniel Leidert ]
* debian/control: Used wrap-and-sort. Added Vcs-Svn and Vcs-Browser fields.
  (Priority): Moved to extra according to policy section 2.5.
  (Standards-Version): Bumped to 3.9.2.
  (Description): Fixed a typo.
* debian/watch: Added.
* debian/patches/03_hurd-i386_define_path_max.patch: Added.
  - Define MAX_PATH if not defines to fix FTBFS on hurd.
* debian/patches/series: Adjusted.

Show diffs side-by-side

added added

removed removed

Lines of Context:
2
2
     $     g_vecs, title, 
3
3
     $     oevals, evals, oirs, irs, oocc, occ)
4
4
*
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 $
6
6
*
7
7
      implicit none
8
8
#include "errquit.fh"
92
92
         call util_print_centered(LuOut,title, 40, .true.)
93
93
         write(LuOut,*)
94
94
c
95
 
 110  continue
 
95
 110     continue
96
96
         do i = ilo, ihi
97
97
c
98
98
            call ga_get(g_vecs, 1, nbf, i, i, dbl_mb(k_vecs), 1)
130
130
            endif
131
131
            do j = 0, n-1
132
132
               do k = 0, j
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))))
 
142
     &                   .and..not.
 
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
 
146
                       m = int_mb(k_list+j)
 
147
                       int_mb(k_list+j) = int_mb(k_list+k)
 
148
                       int_mb(k_list+k) = m
 
149
                     endif
 
150
                  else
 
151
c                    the ordering is OK so do nothing
138
152
                  endif
139
153
               enddo
140
154
            enddo
445
459
      lmax = 2
446
460
c
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,
450
464
     &       GA_ERR)
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,
453
467
     &       GA_ERR)
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)
456
470
c
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