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