1      logical function md_set(rtdb)
2      implicit none
3      integer rtdb
4
5#include "inp.fh"
6#include "mafdecls.fh"
7#include "rtdb.fh"
8#include "stdio.fh"
9#include "errquit.fh"
10#include "util.fh"
11#include "global.fh"
12#include "geom.fh"
13c      external md_driver
14c
15      integer geom,natom
16      integer md_data_get_i_c, md_data_get_i_m, md_data_get_i_q
17      integer md_data_get_i_t, md_data_get_i_v, md_data_get_i_a
18      integer md_data_get_i_b, md_data_get_i_d, md_data_get_i_f
19      integer md_data_get_natom
20
21      integer coor,mass,bq,tag,vel,acc,bterm,dterm,frc
22
23      integer i
24
25c      set input parameters
26c      write(*,*) ' In MD_SET '
27      call md_data_inp_set(rtdb)
28c      write(*,*) ' In MD_SET -1'
29cc     create geometry object
30      if (.not. geom_create(geom, 'geometry'))
31     & call errquit('md_set_getgeom: failed creating geometry',
32     & 0,GEOM_ERR)
33cC     load geometry into the object
34      if (.not. geom_rtdb_load(rtdb, geom, 'geometry'))
35     & call errquit('md_set_getgeom: no geometry',
36     & 0,RTDB_ERR)
37
38cc    Set the natom, it is needed for all other allocations
39      natom=md_data_get_natom()
40
41C     Get the handles for everything
42      coor=md_data_get_i_c()
43      mass=md_data_get_i_m()
44      bq=md_data_get_i_q()
45      tag=md_data_get_i_t()
46      vel=md_data_get_i_v()
47      acc=md_data_get_i_a()
48      bterm=md_data_get_i_b()
49      dterm=md_data_get_i_d()
50      frc=md_data_get_i_f()
51c
52c
53cC ----- Fill up the local copies with data(mass,coords,charge,tags) from geometry object
54cC------- accessed by the geom handle
55      call md_data_geom_copy(rtdb,geom)
56
57c      write(*,*)  coor,mass,bq,tag,vel,acc,bterm,dterm,frc
58
59C ----- get initial velocities and accelerations and other inital conditions
60c       if (.not. grad(rtdb))
61c     & call errquit('md_gradient: grad not calculated', 0, RTDB_ERR)
62c  ---- get the gradient to fill up the force array
63c      if (.not. rtdb_get(rtdb,theory,mt_dbl,3*natom,dbl_mb(frc)))
64c     & call errquit('md_gradient:  no grad found', 0, RTDB_ERR)
65      do i=1,3*natom
66         dbl_mb(coor+i-1)=0.0
67         dbl_mb(vel+i-1)=0.0
68         dbl_mb(acc+i-1)=0.0
69         dbl_mb(bterm+i-1)=0.0
70         dbl_mb(dterm+i-1)=0.0
71      enddo
72
73      if (.not. geom_destroy(geom))
74     & call errquit('md_set:  geom_destroy failed',
75     & 911,GEOM_ERR)
76c      write(*,*) 'OUt of MD_set'
77      md_set=.true.
78      end
79
80
81
82c $Id$
83