← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/nwpw/nwpwlib/Pneb/Pneb.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
http://bugs.debian.org/632611
https://launchpad.net/bugs/791308
* 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:
src/nwpw/nwpwlib/Pneb/Pneb.F
1
1
*
2
 
* $Id: Pneb.F,v 1.42 2009-02-08 03:26:09 bylaska Exp $
 
2
* $Id: Pneb.F 21841 2012-01-24 00:16:45Z bylaska $
3
3
*
4
4
#define NBLOCKS 4
5
5
 
955
955
           if (n.eq.0) go to 30
956
956
 
957
957
              call Cram_ccm_izgemm(nb,n,n,Y1(shift),Y2(shift),
958
 
     >                            one,zero,hml(shift2))
 
958
     >                             one,zero,hml(shift2))
959
959
 
960
960
              if (spin_orbit) then
961
 
                 call Cram_ccm_izgemm(nb,n,n,Y1(shiftso),Y2(shiftso),
 
961
                call Cram_ccm_izgemm(nb,n,n,Y1(shiftso),Y2(shiftso),
962
962
     >                               one,one,hml(shift2))
963
963
              end if
964
964
 
1021
1021
 
1022
1022
      do nb=nb1,nb2
1023
1023
         do ms=ms1,ms2
1024
 
           shift  = 1 + (ms-1)*ne(1)*npack1 +
1025
 
     >                     (nb-nb1)*(ne(1)+ne(2))*npack1
 
1024
           shift  = 1 + (ms-1)*ne(1)*npack1 
 
1025
     >                + (nb-nb1)*(ne(1)+ne(2))*npack1
1026
1026
           shiftso = shift + ne(1)*npack1
1027
 
           shift2 = 1 + (ms-1)*ishift2      +(nb-nb1)*ishift3
 
1027
           shift2 = 1 + (ms-1)*ishift2 
 
1028
     >                +(nb-nb1)*ishift3
1028
1029
           n = ne(ms)
1029
1030
           if (n.eq.0) go to 30
1030
1031
 
1031
1032
              call Cram_ccm_sym_izgemm(nb,n,Y1(shift),Y2(shift),
1032
 
     >                            one,zero,hml(shift2))
 
1033
     >                                 one,zero,hml(shift2))
1033
1034
 
1034
1035
              if (spin_orbit) then
1035
1036
                 call Cram_ccm_sym_izgemm(nb,n,Y1(shiftso),Y2(shiftso),
1036
 
     >                               one,one,hml(shift2))
 
1037
     >                                    one,one,hml(shift2))
1037
1038
              end if
1038
1039
 
1039
1040
 30        continue
1067
1068
#include "Pneb.fh"
1068
1069
 
1069
1070
*     **** local variables ****
1070
 
      complex*16 zero,one
1071
 
      parameter (zero=(0.0d0,0.0d0),one=(1.0d0,0.0d0))
1072
 
 
1073
1071
      integer nb,nb1,nb2,ms,ms1,ms2,n
1074
1072
      integer shift,shiftso,shift2,ishift2,ishift3
1075
1073
 
1095
1093
 
1096
1094
      do nb=nb1,nb2
1097
1095
         do ms=ms1,ms2           
1098
 
            shift = 1 + (ms-1)*ne(1)*npack1 +
1099
 
     >              (nb-nb1)*(ne(1)+ne(2))*npack1
 
1096
            shift = 1 + (ms-1)*ne(1)*npack1
 
1097
     >                +  (nb-nb1)*(ne(1)+ne(2))*npack1
1100
1098
            shiftso = shift + ne(1)*npack1
1101
 
            shift2  = 1 + (ms-1)*ishift2 +((nb-nb1))*ishift3
 
1099
            shift2  = 1 + (ms-1)*ishift2 
 
1100
     >                  + (nb-nb1)*ishift3
1102
1101
            n = ne(ms)
1103
1102
            if (n.eq.0) go to 30
1104
1103
 
1406
1405
 
1407
1406
c     *** local variables ***
1408
1407
      logical value
1409
 
      integer nb,nb1,nb2,ms,ms1,ms2
 
1408
      integer nb,nb1,nb2,ms,ms1,ms2,i,j,k
1410
1409
      integer rwork(2),work(2),lwork,ierr
1411
1410
      integer vindex,sindex
 
1411
      integer W(2),VL(2),VR(2)
1412
1412
 
1413
1413
      if (nbb.eq.0) then
1414
1414
        nb1=1
1446
1446
     >                 ierr)
1447
1447
           if (ierr.ne.0) 
1448
1448
     >       call errquit("Pneb_w_diag: ZHEEV failed",ierr,0)
1449
 
        endif
 
1449
 
 
1450
        end if
1450
1451
 
1451
1452
        vindex=vindex + ne(ms)*ne(ms)
1452
1453
        sindex=sindex + ne(ms)       
1453
1454
      end do
1454
1455
      end do
1455
 
             
1456
1456
 
1457
1457
c     ***** pop stack memory *****
1458
1458
      value=          MA_pop_stack(work(2))
1590
1590
       end if
1591
1591
 
1592
1592
c     ***  compute C = Y'*Y ( ne x ne )= V*S*S*V' ****
1593
 
      call Pneb_ffw_Multiply(mbb,nbb,Y,Y,npack1,V)
 
1593
      call Pneb_ffw_hermit_Multiply(mbb,nbb,Y,Y,npack1,V)
1594
1594
 
1595
1595
 
1596
1596
c     ***  compute S2=S*S and V from C  **** 
2703
2703
      indx=1
2704
2704
      do nb=nb1,nb2
2705
2705
      do ms=ms1,ms2
2706
 
         call ZGEMM('N','N',ne(ms),ne(ms),ne(ms),
2707
 
     >              alpha,
2708
 
     >              A(indx),ne(ms),
2709
 
     >              B(indx),ne(ms),
2710
 
     >              beta,
2711
 
     >              C(indx),ne(ms))
2712
 
        indx = indx + ne(ms)*ne(ms)
 
2706
         if (ne(ms).gt.0) then
 
2707
            call ZGEMM('N','N',ne(ms),ne(ms),ne(ms),
 
2708
     >                 alpha,
 
2709
     >                 A(indx),ne(ms),
 
2710
     >                 B(indx),ne(ms),
 
2711
     >                 beta,
 
2712
     >                 C(indx),ne(ms))
 
2713
            indx = indx + ne(ms)*ne(ms)
 
2714
         end if
2713
2715
      end do
2714
2716
      end do
2715
2717
      return
2740
2742
      indx=1
2741
2743
      do nb=nb1,nb2
2742
2744
      do ms=ms1,ms2
2743
 
         call ZGEMM('C','N',ne(ms),ne(ms),ne(ms),
2744
 
     >              alpha,
2745
 
     >              A(indx),ne(ms),
2746
 
     >              B(indx),ne(ms),
2747
 
     >              beta,
2748
 
     >              C(indx),ne(ms))
2749
 
        indx = indx + ne(ms)*ne(ms)
 
2745
         if (ne(ms).gt.0) then
 
2746
            call ZGEMM('C','N',ne(ms),ne(ms),ne(ms),
 
2747
     >                 alpha,
 
2748
     >                 A(indx),ne(ms),
 
2749
     >                 B(indx),ne(ms),
 
2750
     >                 beta,
 
2751
     >                 C(indx),ne(ms))
 
2752
            indx = indx + ne(ms)*ne(ms)
 
2753
         end if
2750
2754
      end do
2751
2755
      end do
2752
2756
      return
2777
2781
      indx=1
2778
2782
      do nb=nb1,nb2
2779
2783
      do ms=ms1,ms2
2780
 
         call ZGEMM('N','C',ne(ms),ne(ms),ne(ms),
2781
 
     >              alpha,
2782
 
     >              A(indx),ne(ms),
2783
 
     >              B(indx),ne(ms),
2784
 
     >              beta,
2785
 
     >              C(indx),ne(ms))
2786
 
        indx = indx + ne(ms)*ne(ms)
 
2784
         if (ne(ms).gt.0) then
 
2785
            call ZGEMM('N','C',ne(ms),ne(ms),ne(ms),
 
2786
     >                 alpha,
 
2787
     >                 A(indx),ne(ms),
 
2788
     >                 B(indx),ne(ms),
 
2789
     >                 beta,
 
2790
     >                 C(indx),ne(ms))
 
2791
            indx = indx + ne(ms)*ne(ms)
 
2792
         end if
2787
2793
      end do
2788
2794
      end do
2789
2795
      return