1c
2c $Id$
3c
4
5      SUBROUTINE smd_util_rebox(n,latt,rlatt,aaa)
6
7      implicit none
8
9      integer n
10      double precision rlatt(3,3),latt(3,3)
11      double precision  aaa(n,3)
12c
13      integer i
14      double precision  ssx,ssy,ssz,xss,yss,zss
15      logical oprint
16
17
18      if(n.eq.1) then
19       oprint =.true.
20      else
21       oprint = .false.
22      end if
23      oprint = .false.
24      do i=1,n
25
26       if(oprint)
27     >          write(*,*) "rebox",aaa(i,1),aaa(i,2),aaa(i,3)
28       ssx=(rlatt(1,1)*aaa(i,1)+rlatt(1,2)*aaa(i,2)+rlatt(1,3)*aaa(i,3))
29       ssy=(rlatt(2,1)*aaa(i,1)+rlatt(2,2)*aaa(i,2)+rlatt(2,3)*aaa(i,3))
30       ssz=(rlatt(3,1)*aaa(i,1)+rlatt(3,2)*aaa(i,2)+rlatt(3,3)*aaa(i,3))
31
32       xss=ssx-nint(ssx)
33       yss=ssy-nint(ssy)
34       zss=ssz-nint(ssz)
35
36       aaa(i,1)=(latt(1,1)*xss+latt(1,2)*yss+latt(1,3)*zss)
37       aaa(i,2)=(latt(2,1)*xss+latt(2,2)*yss+latt(2,3)*zss)
38       aaa(i,3)=(latt(3,1)*xss+latt(3,2)*yss+latt(3,3)*zss)
39
40      enddo
41
42      return
43
44      END
45
46      subroutine smd_util_print_force_array(un,na,
47     >                           fff)
48
49      implicit none
50      integer un
51      integer na
52      double precision fff(na,3)
53c
54      integer i
55      do i=1,na
56         write(un,*) i, fff(i,1),fff(i,2),fff(i,3)
57      end do
58      return
59
60      end
61
62      subroutine smd_util_print_charge_array(un,na,lo,hi,
63     >                           fff)
64
65      implicit none
66      integer un
67      integer na
68      double precision fff(na)
69c
70      integer i,lo,hi
71      do i=lo,hi
72         write(un,*) i, fff(i)
73      end do
74      return
75
76      end
77
78      SUBROUTINE tool_randm(iseed,x)
79
80      implicit none
81
82      integer i,iseed,itoz,itozz,mz,mult
83
84      real*8 x,add,dimax,ddimax
85c     real*8 rand
86
87      logical newjob
88
89      dimension mz(250)
90
91      save newjob,itoz,dimax,ddimax
92
93      data newjob/.true./
94
95*     **** external functions ****
96      real*8   util_random
97      external util_random
98
99      if(newjob)then
100       if(mod(iseed,2).eq.0)iseed=iseed+1
101       mult=65539
102       add=2147483648.0d00
103       dimax=1.0d00/add
104       ddimax=0.50d00*dimax
105       do i=1,250
106        x=util_random(iseed)
107        mz(i)=x*iseed
108       enddo
109       itoz=1
110       newjob=.false.
111      else
112       itoz=itoz+1
113       if(itoz.gt.250)itoz=itoz-250
114       itozz=itoz+103
115       if(itozz.gt.250)itozz=itozz-250
116       mz(itoz)=ieor(mz(itoz),mz(itozz))
117       x=mz(itoz)*dimax+ddimax
118       x=2.0d00*x
119      endif
120
121      return
122
123      END
124
125       FUNCTION erfxc(x)
126
127      implicit none
128
129      double precision erfxc
130      real*8 a1,a2,a3,a4,a5,p
131
132      parameter ( a1 = 0.254829592, a2 = -0.284496736 )
133      parameter ( a3 = 1.421413741, a4 = -1.453152027 )
134      parameter ( a5 = 1.061405429, p  =  0.327591100 )
135
136      real*8 t,x,xsq,tp
137
138      t=1.0/(1.0+p*x)
139      xsq=x*x
140
141      tp=t*(a1+t*(a2+t*(a3+t*(a4+t*a5))))
142
143      erfxc=tp*exp(-xsq)
144
145      return
146
147      END
148
149      subroutine smd_ma_char_print(nt,ns,t,un)
150      implicit none
151#include "smd_const_data.fh"
152c
153      integer nt,un,ns
154      character(1) t(nt*ns)
155
156      integer i,j
157
158      do i=1,nt
159          write(un,'(72A1)')
160     >      (t(ns*(i-1)+j),j=1,ns)
161
162      end do
163
164      end
165      subroutine smd_set_char_to_ma(nt,myname,t)
166      implicit none
167c
168      integer nt
169      character*(32) t(nt)
170      character*(*) myname(nt)
171
172      integer i
173
174      do i=1,nt
175        t(i) = myname(i)
176      end do
177
178      end
179      subroutine smd_set_ma_to_char(nt,myname,t)
180      implicit none
181c
182      integer nt
183      character*(*) t(nt)
184      character*(32) myname(nt)
185
186      integer i
187
188      do i=1,nt
189        t(i) = " "
190        t(i) = myname(i)
191      end do
192
193      end
194      subroutine smd_set_ma_char(nt,myname,t)
195      implicit none
196c
197      integer nt
198      character(1) t(nt)
199      character(1) myname(nt)
200
201      integer i
202
203      do i=1,nt
204        t(i) = myname(i)
205      end do
206
207      end
208
209      subroutine smd_ma_char_count(s,t,nt)
210      implicit none
211c
212#include "inp.fh"
213      integer nt
214      character*(*) s
215      character*(*) t
216
217      integer istart,iend
218
219      istart = 0
220      nt = 0
221  10  if (inp_strtok(t,s, istart, iend)) then
222      nt = nt +1
223      goto 10
224      endif
225
226      end
227
228