← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/nwdft/input_dft/occup_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/nwdft/input_dft/occup_input.F
 
1
      subroutine occup_input(rtdb)
 
2
C     $Id: occup_input.F 21176 2011-10-10 06:35:49Z d3y133 $
 
3
C     Adapted from geom_input
 
4
c     Occupations format:
 
5
c     occupations [nfocc_in]
 
6
c     [focc-1]
 
7
c     [focc-2]
 
8
c      ...
 
9
c     [focc-nfocc_in]
 
10
c     end
 
11
c     For example:
 
12
c     occupations 5
 
13
c     0.25
 
14
c     0.1
 
15
c     1.7
 
16
c     1.1
 
17
c     0.175
 
18
c     end
 
19
c     RESTRICTIONS:
 
20
c     2. [focc-1]   is integer or float and positive
 
21
c     3. [nfocc_in] is integer and positive and < nmo*2
 
22
c        Note.- In so-dft the MOs are arranged as 
 
23
c        {nmo-alpha-1 nmo-beta-1}{nmo-alpha-2 nmo-beta-2} ...
 
24
c        As an example: In CH2 which is triplet we have for 6-311G*
 
25
c        nmo=25
 
26
c        Default occupations are: 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
 
27
c        This means 8 pairs of 1's.
 
28
c        This would be defined in our occupation module scheme as
 
29
c        This scheme is designed for so-dft calculation.
 
30
c        Note.- For other type of calculation is not done yet.
 
31
c        occupations 5 3
 
32
c        1.0 1.0
 
33
c        1.0 1.0
 
34
c        1.0 1.0
 
35
c        1.0
 
36
c        1.0
 
37
c        end
 
38
c     FA-02-10-11
 
39
      implicit none
 
40
#include "errquit.fh"
 
41
#include "stdio.fh"
 
42
#include "inp.fh"
 
43
#include "global.fh"
 
44
#include "rtdb.fh"
 
45
#include "nwc_const.fh"
 
46
#include "mafdecls.fh"
 
47
#include "util.fh"
 
48
      integer rtdb              ! [input]     
 
49
      character*255 field       ! for character input
 
50
      integer ac,noccA,noccB    ! counts no. of centers as input
 
51
      logical status            ! scratch for return codes
 
52
      integer i,ind_min,ind_max
 
53
      integer nfocc_in(2),nfocc_tot ! input of nfocc
 
54
      integer l_Iocc,k_Iocc
 
55
      integer switch_focc
 
56
c     
 
57
c     read occupations from the input deck 
 
58
c     and output it to the rtdb.
 
59
c     
 
60
c     current input line should begin 'occupations ...'
 
61
c     
 
62
      if (ga_nodeid() .ne. 0) return
 
63
c     
 
64
c     Check that this is indeed a occupations line
 
65
c     
 
66
      call inp_set_field(0)     ! goto start of line
 
67
      if (.not. inp_a(field))
 
68
     $     call errquit('occup_input: no input present', 0, INPUT_ERR)
 
69
      if (.not. inp_compare(.false., 'occup', field))
 
70
     $     call errquit('occup_input: not occup input',
 
71
     &                   0,INPUT_ERR)   
 
72
      status = .true.
 
73
      status = status .and. inp_i(nfocc_in(1))
 
74
      status = status .and. inp_i(nfocc_in(2))
 
75
      if (status) then ! --------nfocc-in---START      
 
76
c       write(*,2) nfocc_in(1),nfocc_in(2)
 
77
c2      format('nfocc_in=(',i5,',',i5,')')  
 
78
        nfocc_tot=nfocc_in(1)+nfocc_in(2)
 
79
        ind_min=2
 
80
        ind_max=1
 
81
        if (nfocc_in(1).lt.nfocc_in(2)) then
 
82
         ind_min=1
 
83
         ind_max=2
 
84
        endif
 
85
        if (.not. ma_push_get(mt_dbl,nfocc_tot,'occup1',
 
86
     &                        l_Iocc,k_Iocc))
 
87
     &  call errquit('occ_input ma_push_get fail k_Iocc',
 
88
     &               0,MA_ERR)  
 
89
c----- Start reading <occ-A> <occ-B> sets
 
90
       noccA=1
 
91
       noccB=1
 
92
       ac = 0
 
93
 20    if (inp_read()) then   ! --- if-read-focc-START
 
94
         status = inp_a(field)
 
95
         if (inp_compare(.false., 'end', field)) then
 
96
            goto 30
 
97
         else
 
98
            if (noccA .gt. nfocc_in(ind_max)) call errquit
 
99
     $           ('occup_input: too many occupations?', 
 
100
     &            ac, INPUT_ERR)
 
101
c        
 
102
c     style input ... <occ-A>  <occ-B> 
 
103
c     
 
104
            call inp_set_field(0)
 
105
            status = .true.
 
106
c ------- Case 1: Reading occ-A occ-B
 
107
          if (noccA .le. nfocc_in(ind_min)) then
 
108
            status = status .and. inp_f(dbl_mb(k_Iocc+ac))
 
109
            status = status .and. inp_f(dbl_mb(k_Iocc+ac+1))
 
110
c           write(*,1) ac,
 
111
c    &                 dbl_mb(k_Iocc+ac),dbl_mb(k_Iocc+ac+1)
 
112
c 1         format('TEST-occ: fractional occupations(',i3,')=(',
 
113
c    &              f15.8,',',f15.8,')')
 
114
            if (.not. status) call errquit
 
115
     $          ('occup_input: <occ>',ac+1,INPUT_ERR)
 
116
            ac = ac + 2
 
117
            noccA=noccA+1
 
118
            noccB=noccB+1
 
119
          else if (ac/2+1 .gt. nfocc_in(ind_min)) then
 
120
c ------- Case 2: Reading occ-A (unpaired electrons)
 
121
            status = status .and. inp_f(dbl_mb(k_Iocc+ac))
 
122
c           write(*,3) ac,
 
123
c    &                 dbl_mb(k_Iocc+ac)
 
124
c 3         format('TEST-occ: fractional occupations(',i3,')=',
 
125
c    &              f15.8)      
 
126
            if (.not. status) call errquit
 
127
     $          ('occup_input: <occ>',ac+1,INPUT_ERR)
 
128
            if (ind_max.eq.1) noccA=noccA+1
 
129
            if (ind_max.eq.2) noccB=noccB+1
 
130
            ac = ac + 1
 
131
          endif
 
132
         end if
 
133
         goto 20
 
134
       else
 
135
         call errquit('occup_input: premature end of file',
 
136
     &                0,INPUT_ERR)
 
137
       end if                 ! --- if-read-focc-END
 
138
      else
 
139
       call errquit(
 
140
     &        'occup_input: missing nfocc-A -B in occupations',
 
141
     &         0,INPUT_ERR) 
 
142
      endif ! --------nfocc-in---END    
 
143
 30   continue    
 
144
c     write(*,5) noccA-1,noccB-1
 
145
c5    format('(noccA,noccB)=(',i5,',',i5,')')
 
146
      if (noccA-1.ne.nfocc_in(1) .or. noccB-1.ne.nfocc_in(2)) then
 
147
         call errquit('occup_input: mismatch noccA-ith or noccB-ith',
 
148
     &                0,INPUT_ERR)      
 
149
      endif
 
150
c ---- check that int_mb(k_nIocc) > 0 and dbl_mb(k_Iocc) > 0
 
151
      do i=1,nfocc_tot
 
152
c      write(*,4) i,dbl_mb(k_Iocc+i-1)
 
153
c4     format('frac-occ-all(',i5,')=',f15.8)
 
154
       if (dbl_mb(k_Iocc+i-1).le.0.0d0) then
 
155
        call errquit('occup_input: Problem focc input ith val<0',
 
156
     &                0,INPUT_ERR)    
 
157
       endif 
 
158
      enddo
 
159
c ----- Store focc in rtdb ----- START   
 
160
       switch_focc=1 ! 1 means using occupations keyword
 
161
      if (.not. rtdb_put(rtdb,'focc:occ-switch',
 
162
     &                   mt_int,1,switch_focc))  
 
163
     &   call errquit('occ_input: rtdb_put failed', 1201, RTDB_ERR)
 
164
      if (.not. rtdb_put(rtdb,'focc:occupations',
 
165
     &                   mt_int,2,nfocc_in))
 
166
     &   call errquit('occ_input: rtdb_put failed', 1201, RTDB_ERR)
 
167
      if (.not. rtdb_put(rtdb,'focc:occup list',
 
168
     &                   mt_dbl,nfocc_tot,dbl_mb(k_Iocc)))
 
169
     $      call errquit('occ_input: rtdb_put failed', 0, RTDB_ERR)
 
170
      if (.not.ma_pop_stack(l_Iocc)) ! Free memory
 
171
     &      call errquit('occ input: ma_pop_stack failed k_Iocc',
 
172
     &                    0,MA_ERR)
 
173
c ----- Store focc in rtdb ----- END    
 
174
50    continue
 
175
      end