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

« back to all changes in this revision

Viewing changes to src/smd/graveyard/smd-9-10-08/smd_atom.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:
 
1
      subroutine smd_atom_init_system()
 
2
      implicit none
 
3
#include "errquit.fh"
 
4
#include "inp.fh"
 
5
#include "mafdecls.fh"
 
6
#include "rtdb.fh"
 
7
#include "util.fh"
 
8
#include "global.fh"
 
9
c     
 
10
      character*32 sp_atom
 
11
      character*32 tag,pname
 
12
      logical result
 
13
 
 
14
      pname = "smd_atom_init_system"
 
15
c
 
16
      tag = "atom"
 
17
      call smd_system_get_component(sp_atom,tag,result)
 
18
      if(.not.result)
 
19
     >  call errquit(
 
20
     >       pname//'no component '//tag,0,0)
 
21
 
 
22
      call smd_atom_init(sp_atom)
 
23
 
 
24
      return
 
25
      end
 
26
 
 
27
      subroutine smd_atom_init(namespace)
 
28
      implicit none
 
29
#include "errquit.fh"
 
30
#include "inp.fh"
 
31
#include "mafdecls.fh"
 
32
#include "rtdb.fh"
 
33
#include "util.fh"
 
34
#include "global.fh"
 
35
#include "smd_const_data.fh"
 
36
#include "geom.fh"
 
37
c     
 
38
      character*(*) namespace
 
39
c
 
40
      character*32 pname
 
41
      character*80 tag
 
42
      integer nt,ns
 
43
      integer i_t,i_tr,i_ir,i_qf
 
44
      integer i_iconst
 
45
      logical result
 
46
c
 
47
      logical geom_tag_to_charge_gen
 
48
      external geom_tag_to_charge_gen
 
49
c
 
50
      pname = "smd_atom_init"
 
51
c
 
52
      call util_message("iin "//pname)
 
53
      write(*,*) "in "//pname
 
54
c
 
55
c     get total number of atoms from pdb file
 
56
c     ---------------------------------------
 
57
      call smd_coordfile_natoms(nt)
 
58
      if(nt.le.0)
 
59
     >  call errquit(
 
60
     >       pname//'no atoms ',0, RTDB_ERR)
 
61
c
 
62
c
 
63
c     create atom namespace
 
64
c     ---------------------
 
65
      call smd_namespace_create(namespace)
 
66
c
 
67
c     create atom data structures
 
68
c     ---------------------------
 
69
      tag = "atom:iconst"
 
70
      call smd_data_create_get(namespace,tag,1,MT_INT,i_iconst)
 
71
      tag = "atom:name"
 
72
      call smd_data_create_get(namespace,tag,nt,MT_STR,i_t)
 
73
      tag  = "atom:resname"
 
74
      call smd_data_create_get(namespace,tag,nt,MT_STR,i_tr)
 
75
      tag = "atom:resid"
 
76
      call smd_data_create_get(namespace,tag,nt,MT_INT,i_ir)
 
77
      tag = "atom:formal_charge"
 
78
      call smd_data_create_get(namespace,tag,nt,MT_DBL,i_qf)
 
79
 
 
80
c
 
81
c    don't ask
 
82
c    --------
 
83
      int_mb(i_iconst) = nt
 
84
c
 
85
c     fill in names from pdb file
 
86
c     ---------------------------
 
87
      call smd_coordfile_read_atomres(nt,
 
88
     +                         byte_mb(i_t),
 
89
     +                         byte_mb(i_tr),
 
90
     +                         int_mb(i_ir))
 
91
 
 
92
      tag = "atom:name"
 
93
      call smd_get_size(tag,ns,result)
 
94
      if(.not.result) call errquit(
 
95
     >       pname//'error getting size',0, RTDB_ERR)
 
96
 
 
97
      ns=ns/nt
 
98
c
 
99
      if(.not.geom_tag_to_charge_gen(nt,ns,
 
100
     >                        byte_mb(i_t),dbl_mb(i_qf)))
 
101
     >  call errquit(
 
102
     >       pname//'error setting formal charge',0, RTDB_ERR)
 
103
 
 
104
      call util_message("out "//pname)
 
105
 
 
106
      return
 
107
      end
 
108
 
 
109
      subroutine smd_atom_ntot(ntot)
 
110
      implicit none
 
111
#include "errquit.fh"
 
112
#include "inp.fh"
 
113
#include "mafdecls.fh"
 
114
#include "rtdb.fh"
 
115
#include "util.fh"
 
116
#include "global.fh"
 
117
c     
 
118
      integer ntot
 
119
c
 
120
      character*72 tag
 
121
      character*30 pname
 
122
      integer i_iconst
 
123
      logical result
 
124
 
 
125
      pname = "smd_atom_ntot"
 
126
      tag = "atom:iconst"
 
127
      call smd_get_ind(tag,i_iconst,result)
 
128
      if(.not. result) 
 
129
     >  call errquit(
 
130
     >       pname//'error getting ntot '//tag,0, RTDB_ERR)
 
131
      ntot = int_mb(i_iconst)
 
132
 
 
133
      return
 
134
      end
 
135
 
 
136
      subroutine smd_atom_nres(namespace,nr)
 
137
      implicit none
 
138
#include "errquit.fh"
 
139
#include "inp.fh"
 
140
#include "mafdecls.fh"
 
141
#include "rtdb.fh"
 
142
#include "util.fh"
 
143
#include "global.fh"
 
144
c     
 
145
      character*(*) namespace
 
146
      integer nr
 
147
c
 
148
      character*72 tag
 
149
      character*30 pname
 
150
      integer i_ir
 
151
      logical result
 
152
      integer nt
 
153
      integer ir,ir0,i
 
154
 
 
155
      pname = "smd_atom_nres"
 
156
      tag = "atom:resid"
 
157
      call smd_data_get_index(namespace,tag,i_ir,result)
 
158
      if(.not. result) 
 
159
     >  call errquit(
 
160
     >       pname//'error getting '//tag,0, RTDB_ERR)
 
161
      call smd_data_get_dim(namespace,tag,nt,result)
 
162
      if(.not. result) 
 
163
     >  call errquit(
 
164
     >       pname//'error getting size '//tag,0, RTDB_ERR)
 
165
 
 
166
      nr = 0
 
167
      ir0 = 0
 
168
      do i=1,nt
 
169
       ir = int_mb(i_ir+i-1)
 
170
       if(ir0.ne.ir) then
 
171
          ir0=ir
 
172
          nr = nr + 1
 
173
       end if
 
174
      end do
 
175
       
 
176
      return
 
177
      end
 
178
 
 
179
      subroutine smd_atom_ntot1(namespace,ntot)
 
180
      implicit none
 
181
#include "errquit.fh"
 
182
#include "inp.fh"
 
183
#include "mafdecls.fh"
 
184
#include "rtdb.fh"
 
185
#include "util.fh"
 
186
#include "global.fh"
 
187
c     
 
188
      character*(*) namespace
 
189
      integer ntot
 
190
c
 
191
      character*72 tag
 
192
      character*30 pname
 
193
      logical result
 
194
 
 
195
      pname = "smd_atom_ntot"
 
196
      tag = "atom:xyz"
 
197
      call smd_data_get_dim(namespace,tag,ntot,result)
 
198
      if(.not. result) 
 
199
     >  call errquit(
 
200
     >       pname//'error getting size for '//tag,0, RTDB_ERR)
 
201
      ntot = ntot/3
 
202
 
 
203
      return
 
204
      end
 
205