← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/property/cosmo.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/property/cosmo.F
412
412
      status = rtdb_get(rtdb,'cosmo:lineq',mt_int,1,lineq) 
413
413
      nrad = 0
414
414
      if (.not. rtdb_get(rtdb,'cosmo:nrrad',mt_int,1,nrad)) nrad = 0
 
415
      if (nrad.gt.nat) call 
 
416
     &   errquit('cosmo_init:nr radii gt nr atoms?',911,MA_ERR)
415
417
      if (nrad.gt.0) then
416
418
         status=rtdb_get(rtdb,'cosmo:radius',mt_dbl,nrad,dbl_mb(k_rad))
417
419
      endif
690
692
c
691
693
c     ----- approximate sphere with segments and points -----
692
694
c
 
695
      do iat = 1, mxatm
 
696
        nspa(iat) = 0
 
697
        nppa(iat) = 0
 
698
      enddo
693
699
      nseg = 0
694
700
      nfac = 0
695
701
      ndiv = 0
783
789
      data zero    /0.0d+00/
784
790
      integer l_efcc, k_efcc, l_efcs, k_efcs, l_efcz, k_efcz
785
791
      integer l_efclb, k_efclb, k_efciat, l_efciat
 
792
      double precision ratm_real
786
793
c
787
794
      dist(xi,yi,zi,xj,yj,zj)=sqrt((xj-xi)**2+(yj-yi)**2+(zj-zi)**2)
788
795
c
956
963
      ief   =0
957
964
      do iat=1,nat
958
965
         if(ratm(iat).ne.zero) then
 
966
            ratm_real=ratm(iat)-rsolv/bohr
959
967
            do iseg=1,nseg
960
968
               if(.not.insseg(iseg,iat)) then
961
969
                  ief=ief+1
962
970
                  do i=1,3
963
971
                     dbl_mb(k_efcc+3*(ief-1)+i-1)=xyzatm(i,iat)
964
 
     1                          +xyzseg(i,iseg)*ratm(iat)
 
972
     1                          +xyzseg(i,iseg)*ratm_real
965
973
                  enddo
966
974
                  ipp=numpps(iseg,iat)
967
 
                  dbl_mb(k_efcs+ief-1) = dble(ipp)*dsurf*ratm(iat)**2
968
 
                  srfmol   = srfmol + dble(ipp)*dsurf*ratm(iat)**2
969
 
                  volmol   = volmol + dble(ipp)*dvol *ratm(iat)**3
 
975
                  dbl_mb(k_efcs+ief-1) = dble(ipp)*dsurf*ratm_real**2
 
976
                  srfmol   = srfmol + dble(ipp)*dsurf*ratm_real**2
 
977
                  volmol   = volmol + dble(ipp)*dvol *ratm_real**3
970
978
                  int_mb(k_efciat+ief-1)=iat
971
979
               endif
972
980
            enddo
1927
1935
      data one    /1.0d+00/
1928
1936
      data two    /2.0d+00/
1929
1937
      integer g_dens(ndens)
 
1938
      double precision bohr
 
1939
      parameter (bohr=0.529177249d0)
1930
1940
c
1931
1941
      logical util_io_unit
1932
1942
      external util_io_unit
2515
2525
c
2516
2526
c     printing cosmo charges for bq module
2517
2527
c     -------------------------------------
2518
 
      cosmo_file = "cosmo.xyzq"
 
2528
      cosmo_file = "cosmo.xyz"
2519
2529
      call util_file_name_resolve(cosmo_file,.false.)
2520
2530
      if(ga_nodeid().eq.0) then
2521
2531
        if(.not.util_io_unit(80,90,fn))
2522
2532
     +     call errquit('cannot get free unit', 0,
2523
2533
     +       0)
2524
 
 
 
2534
c
2525
2535
        open(unit=fn,form="formatted",file=cosmo_file)
2526
 
        write(*,*) "printing cosmo charges for bq module",
 
2536
        if (dbug) then
 
2537
          write(*,*) "printing cosmo charges for bq module",
2527
2538
     +     cosmo_file
2528
 
 
 
2539
        end if
 
2540
c
 
2541
        write(fn,*) nefc
 
2542
        write(fn,*) "cosmo charges"
2529
2543
        do ief=1,nefc
2530
2544
           write(fn,*) 
2531
 
     +      efcz(  ief),
2532
 
     +      efcc(1,ief),
2533
 
     +      efcc(2,ief),
2534
 
     +      efcc(3,ief)
 
2545
     +      "Bq",
 
2546
     +      efcc(1,ief)*bohr,
 
2547
     +      efcc(2,ief)*bohr,
 
2548
     +      efcc(3,ief)*bohr,
 
2549
     +     -efcz(  ief)
2535
2550
        end do
2536
2551
        close(fn)
2537
2552
      end if
2629
2644
c          w.h.press, b.p.flannery, s.a.teukolsky, w.t.vetterling
2630
2645
c
2631
2646
#include "errquit.fh"
 
2647
#include "stdio.fh"
2632
2648
c
2633
2649
      logical     dbug
2634
2650
      double precision efcc(3,n),efcs(n)
2831
2847
      if(a(n,n).eq.zero) a(n,n)=tiny
2832
2848
      return
2833
2849
      end
 
2850
c $Id: cosmo.F 21213 2011-10-19 21:16:35Z d3y133 $