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