Fixed velocity input in geom for system crystal option...EJB

src/geom/geom.F

@@ -1814,6 +1814,7 @@ c
       end do
 c
       end
+
 c
 C> \brief Extract only the coordinates and charges from a geometry
 C> instance
@@ -2762,8 +2763,11 @@ c
          call util_print_centered(LuOut,'Velocities',40,.true.)
          write(LuOut,3) 
          do icent = 1, ncenter(geom)
+            do i = 1, 3
+               tmp(i) = velocities(i,icent,geom)/scale ! Scale units as necessary
+            end do
             write(LuOut,4) icent, tags(icent,geom), charge(icent,geom),
-     $           (velocities(i,icent,geom),i=1,3)
+     $           (tmp(i),i=1,3)
          end do
       endif
 c

src/geom/geom_input.F

@@ -677,6 +677,9 @@ c
       if (.not. geom_cart_get(geom, ncenter, tags, coords, charge))
      $     call errquit('geom_input: geom_cart_get failed', 0,
      &       GEOM_ERR)
+      if (.not. geom_vel_get(geom, velocities))
+     $     call errquit('geom_input: geom_vel_get failed', 0,
+     &       GEOM_ERR)
 
 c
 c     If doing user zmatrix then remember values of constant variables

src/nwpw/nwpwlib/ion/ion.F

@@ -3,9 +3,9 @@
 *
 
 *     ***************************
-*     *				*
-*     *		ion_end 	*
-*     *				*
+*     *                         *
+*     *        ion_end          *
+*     *                         *
 *     ***************************
       subroutine ion_end()
       implicit none
@@ -54,9 +54,9 @@
       end
 
 *     ***************************
-*     *				*
-*     *		ion_write	*
-*     *				*
+*     *                         *
+*     *        ion_write        *
+*     *                         *
 *     ***************************
       subroutine ion_write(rtdb)
       implicit none
@@ -164,9 +164,9 @@
       end
 
 *     ***************************
-*     *				*
-*     *		ion_destroy 	*
-*     *				*
+*     *                         *
+*     *        ion_destroy      *
+*     *                         *
 *     ***************************
       subroutine ion_destroy()
       implicit none
@@ -187,9 +187,9 @@
     
 
 *     ***************************
-*     *				*
-*     *		ion_init	*
-*     *				*
+*     *                         *
+*     *        ion_init         *
+*     *                         *
 *     ***************************
 *
 *        This routine reads in the ion data structure from the
@@ -1991,9 +1991,9 @@ c      end if
 
 
 *     ***************************
-*     *				*
-*     *		ion_vion	*
-*     *				*
+*     *                         *
+*     *          ion_vion       *
+*     *                         *
 *     ***************************
 
       double precision function ion_vion(i,j)

src/symmetry/sym_nwc.F

@@ -78,10 +78,17 @@ c
      &     latags, iatags)
       LResult = MA_Push_Get(MT_Dbl,nata*(nops+1)*3,'scratch atoms',
      &     lcoord, icoord) .and. lresult
+      LResult = MA_Push_Get(MT_Dbl,nata*(nops+1)*3,'scratch velocities',
+     &     lvel, ivel) .and. lresult
       Lresult = MA_Push_Get(MT_Int,nata,'distinct atoms',ldatom,idatom)
      $     .and. lresult
       if (.not. lresult) call errquit('sym_nwc: dosymops ma failed', 0,
      &       MA_ERR)
+      do ii=1,nata
+          dbl_mb(ivel+3*(ii-1))   = velocities(1,ii,geom)
+          dbl_mb(ivel+3*(ii-1)+1) = velocities(2,ii,geom)
+          dbl_mb(ivel+3*(ii-1)+2) = velocities(3,ii,geom)
+      end do
 c
       call dosymops(sym_ops(1,1,geom),nops,coords(1,1,geom),
      $     tags(1,geom),nata,
@@ -89,6 +96,7 @@ c
      $     cdist,cang,Int_MB(idatom), 
      $     charge(1,geom), charge_new, geom_mass(1,geom),
      $     mass_new, geom_invnucexp(1,geom),invnucexp_new,threquiv)
+
 c
       if(nareal.gt.max_cent) then
         write(6,*)' Too many atoms, increase nw_max_atom in ',
@@ -139,7 +147,7 @@ c     remain in icoord.
 c     Note that the memory for the map (lmscr) is now freed in geom_destroy
 c
       call sym_put_in_geom(geom, nata, nareal,
-     $     Byte_MB(iatags), int_mb(idatom), dbl_mb(icoord),
+     $     Byte_MB(iatags), int_mb(idatom),dbl_mb(icoord),dbl_mb(ivel),
      $     lmscr, imscr, nops, charge_new, mass_new, invnucexp_new)
 c
 c ... sloppy way for the moment to fix units for 2-d case
@@ -221,6 +229,7 @@ c
 c--> final clean up of memory: gensym and dosymops activities
 c
       LResult = MA_Pop_Stack(ldatom)
+      LResult = MA_Pop_Stack(lvel)
       LResult = MA_Pop_Stack(lcoord)
       LResult = MA_Pop_Stack(latags)
 c

src/symmetry/sym_put_geom.F

@@ -1,5 +1,6 @@
       subroutine sym_put_in_geom(geom, nat_uniq, nat_new,
-     $     tags_new, uniq_cent, coords_new, l_map, k_map, nops,
+     $     tags_new, uniq_cent, coords_new, velocities_new,
+     $     l_map, k_map, nops,
      $     charge_new, mass_new, invnucexp_new)
 C$Id$
       implicit none
@@ -14,6 +15,7 @@ C$Id$
       character*16 tags_new(nat_new)
       integer uniq_cent(nat_uniq)
       double precision coords_new(3,nat_new)
+      double precision velocities_new(3,nat_new)
       double precision charge_new(max_cent)
       double precision mass_new(max_cent)
       double precision invnucexp_new(max_cent)
@@ -34,6 +36,9 @@ c
       enddo
       call dgemm('n', 'n', 3, nat_new, 3, 1.0d0, amatrix(1,1,geom), 3,
      $     coords_new, 3, 0.0d0, coords(1,1,geom), 3)
+      call dgemm('n', 'n', 3, nat_new, 3, 1.0d0, amatrix(1,1,geom), 3,
+     $     velocities_new, 3, 0.0d0, velocities(1,1,geom), 3)
+c
 c
       ncenter_unique(geom) = nat_uniq
       ncenter(geom) = nat_new