← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/bq/bq_input.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/bq/bq_input.F
1
 
c $Id: bq_input.F,v 1.8 2006-10-06 06:56:59 marat Exp $
2
 
 
3
 
 
4
 
 
5
 
c     ***  The (current) format of the bq input is as folllows:
6
 
c     ***
7
 
c     ***   bq [units <string units default angstroms> ] 
8
 
c     ***      [(angstrom_to_au || ang2au) <real angstrom_to_au default 1.8897265>]
9
 
c     ***
10
 
c     ***       [bq_filename <string filename default bqcharges>]
11
 
c     ***       [bq_rtdb <string rtdb_charge_tag default cosmo:efcz> <string rtdb_coord_tag default cosmo:efcc>]
12
 
c     ***
13
 
c     ***
14
 
c     ***       { <real charge> <real x y z>
15
 
c     ***         ... }
16
 
c     ***
17
 
c     ***   end
18
 
c     ***
19
 
c     *** units - keyword specifying that a value will be entered by the user
20
 
c     *** for the string variable <units>. The default units for the geometry 
21
 
c     *** input are Angstr�ms (Note: atomic units or Bohr are used within the
22
 
c     *** code, regardless of the option specified for the input units.  The 
23
 
c     *** code recognizes the following possible values  for the string variable <units>:         
24
 
c     ***   angstroms or an -- Angstroms (�), the default (converts to A.U. using the �to A.U. conversion factor)
25
 
c     ***   au or atomic or bohr -- Atomic units (A.U.)
26
 
c     ***   nm or nanometers -- nanometers (converts to A.U. using a conversion factor computed as  times the � to A.U. conversion factor)
27
 
c     ***   pm or picometers -- picometers (converts to A.U. using a conversion factor computed as  times the � to A.U. conversion factor)
28
 
 
 
1
c $Id: bq_input.F 20074 2011-03-08 19:36:13Z niri $
29
2
 
30
3
      subroutine bq_input(rtdb)
31
4
      implicit none
62
35
 
63
36
      call util_print_get_level(print_level)
64
37
      hprint = (ga_nodeid().eq.0).and.(print_high.le.print_level)
65
 
 
66
 
c
67
 
c      write(*,*) "in "//pname
68
 
c
69
 
c
70
 
      max_nbq = min( 4*7000, ma_inquire_avail(MT_INT))
71
 
      max_nbq = max_nbq/4
 
38
c
 
39
      max_nbq = 25000  ! temporary limit for now
72
40
c
73
41
      if ( .not. ma_push_get( MT_DBL, 3*max_nbq, 
74
42
     &      'cbq scratch',
86
54
c
87
55
      call dfill(max_nbq,0.0d0,dbl_mb(i_qbq),1)
88
56
 
89
 
c      if(inp_n_field().gt.2) 
90
 
c     >  call errquit(pname//'too many fields',0,0)
 
57
      if(inp_n_field().gt.2) 
 
58
     >  call errquit(pname//'too many fields',0,0)
91
59
 
92
60
      namespace = bq_default
93
61
 
95
63
 
96
64
 
97
65
c     *** get scale using the form used in geometry ***
98
 
      call bq_get_scalefrominput(scale)
 
66
c      this is not right as it is ignoring the  namespace   
 
67
c      call bq_get_scalefrominput(scale)
99
68
 
100
 
c      scale = 1.88972598858d0
101
 
c      do i=1,inp_n_field()-1
102
 
c        call inp_set_field(i)
103
 
c        if (.not. inp_a(field))   
104
 
c     &    call errquit(pname//': inp_read failed',0,0)
105
 
c        if (inp_compare(.false.,field,'au')) then
106
 
c          scale = 1.0d0       
107
 
c        else if (inp_compare(.false.,field,'angstroms')) then
108
 
c          scale = 1.88972598858d0
109
 
c        else
110
 
c         namespace=field 
111
 
c        end if 
112
 
c      end do
 
69
      scale = 1.88972598858d0
 
70
      do i=1,inp_n_field()-1
 
71
        call inp_set_field(i)
 
72
        if (.not. inp_a(field))   
 
73
     &    call errquit(pname//': inp_read failed',0,0)
 
74
        if (inp_compare(.false.,field,'au')) then
 
75
          scale = 1.0d0       
 
76
        else if (inp_compare(.false.,field,'nm')) then
 
77
          scale = 18.8972598858d0
 
78
        else if (inp_compare(.false.,field,'angstroms')) then
 
79
          scale = 1.88972598858d0
 
80
        else
 
81
         namespace=field 
 
82
        end if 
 
83
      end do
113
84
 
114
85
     
115
86
      ncenter = 0
138
109
            end if
139
110
            call util_file_name_resolve(filename, .false.)
140
111
 
 
112
            ncenter = max_nbq
141
113
            call bq_readfile(filename,ncenter,
142
 
     &                       charge_scale,
143
114
     &                       dbl_mb(i_qbq),
144
115
     &                       dbl_mb(i_cbq))
145
116
            goto 20
296
267
      return
297
268
      end
298
269
 
299
 
 
300
270
*     *************************************************
301
271
*     *                                               *
302
272
*     *               bq_readfile                     *
303
273
*     *                                               *
304
274
*     *************************************************
305
 
      subroutine bq_readfile(filename,ncenter,s,charge,coord)
 
275
      subroutine bq_readfile(filename,ncenter,q,c)
306
276
      implicit none
 
277
#include "util.fh"
 
278
#include "errquit.fh"
 
279
#include "inp.fh"
307
280
      character*(*) filename
308
281
      integer       ncenter
309
 
      double precision s
310
 
      real*8        charge(*)
311
 
      real*8        coord(3,*)
312
 
 
313
 
c
314
 
      double precision q,c(3)
315
 
 
316
 
      ncenter = 0
317
 
      open(unit=99,file=filename,status='old')
318
 
        do while(.true.)
319
 
           read(99,*,ERR=30,END=30) q,c(1),c(2),c(3)
320
 
           charge(ncenter+1)  = charge(ncenter+1)+s*q
321
 
           coord(1,ncenter+1) = c(1)
322
 
           coord(2,ncenter+1) = c(2)
323
 
           coord(3,ncenter+1) = c(3)
324
 
           ncenter = ncenter + 1
325
 
        end do
326
 
  30  close(99)
 
282
      double precision   q(ncenter)
 
283
      double precision   c(3,ncenter)
 
284
 
 
285
c
 
286
      integer fn,fn1,k,i,ipos
 
287
      character*180 buffer
 
288
      character*30 pname,atag
 
289
c
 
290
      logical util_io_unit
 
291
      external util_io_unit
 
292
c
 
293
      pname = "bq_readfile"
 
294
c
 
295
      if(.not.util_io_unit(80,90,fn))
 
296
     +  call errquit(pname//"cannot get io unit",0,0)
 
297
      open(unit=fn,file=filename,status='old',form="formatted")
 
298
      i=0
 
299
10    continue        
 
300
       read(fn,'(A180)',ERR=30,END=30) buffer
 
301
       if(inp_contains(.false.,"bq",buffer,ipos)) then
 
302
         i=i+1
 
303
         if(i.gt.ncenter)
 
304
     +     call errquit(pname//"increase bq stack",i,0)
 
305
         read(buffer,*) atag,(c(k,i),k=1,3),q(i)
 
306
       end if
 
307
      goto 10
 
308
  30  close(fn)
 
309
      ncenter = i
327
310
      return
328
311
      end
329
 
 
330
 
 
331
 
 
332
 
 
333
312
*     *************************************************
334
313
*     *                                               *
335
314
*     *               bq_fromrtdb                     *