1 subroutine smd_input(rtdb) 2c 3 implicit none 4#include "errquit.fh" 5c 6#include "stdio.fh" 7#include "mafdecls.fh" 8#include "inp.fh" 9#include "rtdb.fh" 10c 11 integer rtdb 12c 13 character*32 tag 14 character*32 pname 15 character*255 token 16 character*80 mtoken(10) 17 integer itoken(10) 18 double precision ftoken(10) 19 integer ip,np 20c 21 pname = "smd_input: " 22c 23c write(luout,*) "in ",pname 24c 25 call inp_set_field(0) 26c 27c start parsing input 28c ------------------ 29 if (.not.inp_a(token)) 30 + call errquit(pname//'no input available',0, INPUT_ERR) 31 if (.not.inp_compare(.false.,token,'smd')) 32 + call errquit('smd_input: no input available',0, INPUT_ERR) 33 goto 2 34 1 continue 35 if (.not.inp_read()) call errquit('smd_input: premature EOF',0, 36 & INPUT_ERR) 37 2 continue 38 if(.not.inp_a(token)) goto 1 39c 40c charges 41c ---------- 42 if(inp_compare(.false.,'charge',token)) then 43 call smd_input_charge(rtdb) 44 goto 2 45 endif 46c 47c velocities 48c ---------- 49 if(inp_compare(.false.,'veloc',token)) then 50 call smd_input_veloc(rtdb) 51 goto 2 52 endif 53c 54c coordinates 55c ---------- 56 if(inp_compare(.false.,'coord',token)) then 57 np = 1 58 do ip = 1,np 59 if(.not.inp_a(mtoken(ip))) then 60 call errquit(pname//token,0, 61 & INPUT_ERR) 62 end if 63 end do 64 tag="smd:coordfile" 65 if (.not.rtdb_cput(rtdb,tag,1,mtoken(1))) 66 > call errquit(pname//'failed to store'//tag,0, 67 > RTDB_ERR) 68 goto 2 69 endif 70c 71c parameters 72c ---------- 73 if(inp_compare(.false.,'param',token)) then 74 np = 1 75 do ip = 1,np 76 if(.not.inp_a(mtoken(ip))) then 77 call errquit(pname//token,0, 78 & INPUT_ERR) 79 end if 80 end do 81 tag="smd:paramfile" 82 if (.not.rtdb_cput(rtdb,tag,1,mtoken(1))) 83 > call errquit(pname//'failed to store'//tag,0, 84 > RTDB_ERR) 85 goto 2 86 endif 87c 88c kvec 89c ----- 90 if(inp_compare(.false.,'kvec',token)) then 91 np = 3 92 do ip = 1,np 93 if(.not.inp_i(itoken(ip))) then 94 call errquit(pname//token,0, 95 & INPUT_ERR) 96 end if 97 end do 98 tag="smd:kvec" 99 if (.not.rtdb_put(rtdb,tag,mt_int,3,itoken(1))) 100 > call errquit(pname//'failed to store'//tag,0, 101 > RTDB_ERR) 102 goto 2 103 endif 104c 105c lat_a 106c ----- 107 if(inp_compare(.false.,'lat_a',token)) then 108 np = 3 109 do ip = 1,np 110 if(.not.inp_f(ftoken(ip))) then 111 call errquit(pname//token,0, 112 & INPUT_ERR) 113 end if 114 end do 115 tag="smd:lat_a" 116 if (.not.rtdb_put(rtdb,tag,mt_dbl,3,ftoken(1))) 117 > call errquit(pname//'failed to store'//tag,0, 118 > RTDB_ERR) 119 goto 2 120 endif 121c 122c lat_b 123c ----- 124 if(inp_compare(.false.,'lat_b',token)) then 125 np = 3 126 do ip = 1,np 127 if(.not.inp_f(ftoken(ip))) then 128 call errquit(pname//token,0, 129 & INPUT_ERR) 130 end if 131 end do 132 tag="smd:lat_b" 133 if (.not.rtdb_put(rtdb,tag,mt_dbl,3,ftoken(1))) 134 > call errquit(pname//'failed to store'//tag,0, 135 > RTDB_ERR) 136 goto 2 137 endif 138c 139c lat_c 140c ----- 141 if(inp_compare(.false.,'lat_c',token)) then 142 np = 3 143 do ip = 1,np 144 if(.not.inp_f(ftoken(ip))) then 145 call errquit(pname//token,0, 146 & INPUT_ERR) 147 end if 148 end do 149 tag="smd:lat_c" 150 if (.not.rtdb_put(rtdb,tag,mt_dbl,3,ftoken(1))) 151 > call errquit(pname//'failed to store'//tag,0, 152 > RTDB_ERR) 153 goto 2 154 endif 155c 156c ndata 157c ----- 158 if(inp_compare(.false.,'ndata',token)) then 159 np = 1 160 do ip = 1,np 161 if(.not.inp_i(itoken(ip))) then 162 call errquit(pname//token,0, 163 & INPUT_ERR) 164 end if 165 end do 166 tag="smd:ndata" 167 if (.not.rtdb_put(rtdb,tag,mt_int,np,itoken(1))) 168 > call errquit(pname//'failed to store'//tag,0, 169 > RTDB_ERR) 170 goto 2 171 endif 172c 173c nequil 174c ----- 175 if(inp_compare(.false.,'nequil',token)) then 176 np = 1 177 do ip = 1,np 178 if(.not.inp_i(itoken(ip))) then 179 call errquit(pname//token,0, 180 & INPUT_ERR) 181 end if 182 end do 183 tag="smd:nequil" 184 if (.not.rtdb_put(rtdb,tag,mt_int,np,itoken(1))) 185 > call errquit(pname//'failed to store'//tag,0, 186 > RTDB_ERR) 187 goto 2 188 endif 189c 190c nprint 191c ----- 192 if(inp_compare(.false.,'nprint',token)) then 193 np = 1 194 do ip = 1,np 195 if(.not.inp_i(itoken(ip))) then 196 call errquit(pname//token,0, 197 & INPUT_ERR) 198 end if 199 end do 200 tag="smd:nprint" 201 if (.not.rtdb_put(rtdb,tag,mt_int,np,itoken(1))) 202 > call errquit(pname//'failed to store'//tag,0, 203 > RTDB_ERR) 204 goto 2 205 endif 206c 207c step 208c ----- 209 if(inp_compare(.false.,'step',token)) then 210 np = 1 211 do ip = 1,np 212 if(.not.inp_f(ftoken(ip))) then 213 call errquit(pname//token,0, 214 & INPUT_ERR) 215 end if 216 end do 217 tag="smd:step" 218 if (.not.rtdb_put(rtdb,tag,mt_dbl,np,ftoken(1))) 219 > call errquit(pname//'failed to store'//tag,0, 220 > RTDB_ERR) 221 goto 2 222 endif 223c 224c rcut 225c ---- 226 if(inp_compare(.false.,'rcut',token)) then 227 np = 1 228 do ip = 1,np 229 if(.not.inp_f(ftoken(ip))) then 230 call errquit(pname//token,0, 231 & INPUT_ERR) 232 end if 233 end do 234 tag="smd:rcut" 235 if (.not.rtdb_put(rtdb,tag,mt_dbl,np,ftoken(1))) 236 > call errquit(pname//'failed to store'//tag,0, 237 > RTDB_ERR) 238 goto 2 239 endif 240c 241c temp 242c ----- 243 if(inp_compare(.false.,'temp',token)) then 244 np = 1 245 do ip = 1,np 246 if(.not.inp_f(ftoken(ip))) then 247 call errquit(pname//token,0, 248 & INPUT_ERR) 249 end if 250 end do 251 tag="smd:temp_target" 252 if (.not.rtdb_put(rtdb,tag,mt_dbl,np,ftoken(1))) 253 > call errquit(pname//'failed to store'//tag,0, 254 > RTDB_ERR) 255 goto 2 256 endif 257c 258c ewald 259c ----- 260 if(inp_compare(.false.,'ewald',token)) then 261 np = 1 262 do ip = 1,np 263 if(.not.inp_f(ftoken(ip))) then 264 call errquit(pname//token,0, 265 & INPUT_ERR) 266 end if 267 end do 268 tag="smd:ewald" 269 if (.not.rtdb_put(rtdb,tag,mt_dbl,np,ftoken(1))) 270 > call errquit(pname//'failed to store'//tag,0, 271 > RTDB_ERR) 272 goto 2 273 endif 274c 275c verlet 276c ------ 277 if(inp_compare(.false.,'verlet',token)) then 278 np = 1 279 do ip = 1,np 280 if(.not.inp_f(ftoken(ip))) then 281 call errquit(pname//token,0, 282 & INPUT_ERR) 283 end if 284 end do 285 tag="smd:verlet" 286 if (.not.rtdb_put(rtdb,tag,mt_dbl,np,ftoken(1))) 287 > call errquit(pname//'failed to store'//tag,0, 288 > RTDB_ERR) 289 goto 2 290 endif 291c 292c print level 293c ------------------- 294 if (inp_compare(.false.,'print', token)) then 295 call util_print_input(rtdb, "smd") 296 go to 2 297 end if 298c 299 if (token.eq.'end') then 300c write(luout,*) "out of ",pname 301c write(*,*) "RTDB after smd" 302c if(.not.rtdb_print(rtdb,.true.)) 303c > call errquit(pname//'failed to print rtdb',0, 304c > RTDB_ERR) 305 return 306 endif 307c 308 if(.not.rtdb_print(rtdb,.true.)) 309 > call errquit(pname//'failed to print rtdb',0, 310 > RTDB_ERR) 311 write(luout,*)' unrecognized token in smd input:', 312 + token(1:inp_strlen(token)) 313 call errquit(pname//'failed ',0, 314 > RTDB_ERR) 315 return 316998 call errquit(pname//'no token found '//token,0, 317 > RTDB_ERR) 318999 call errquit(pname//'failed to store '//tag,0, 319 > RTDB_ERR) 320 321 end 322 323 subroutine smd_input_veloc(rtdb) 324c 325 implicit none 326#include "errquit.fh" 327#include "stdio.fh" 328#include "mafdecls.fh" 329#include "inp.fh" 330#include "rtdb.fh" 331c 332 integer rtdb 333c 334 character*32 tag 335 character*32 pname 336 character*255 token 337 integer ip,np 338c 339 pname = "smd_input_vel" 340c 341 write(luout,*) "in ",pname 342c 343 np = inp_n_field() 344c 345 if(np.eq.1) goto 200 346c 347 call inp_set_field(1) 348c 349c start parsing input 350c ------------------ 3512 continue 352 if(inp_cur_field().eq.np) return 353 if (.not.inp_a(token)) 354 + call errquit(pname,0, INPUT_ERR) 355 write(*,*) "current token",token, 356 + inp_cur_field(),np 357c 358c input files 359c ----------- 360 if(inp_compare(.false.,'input',token) ) then 361 if(.not.inp_a(token)) 362 > call errquit(pname//' input ',0,INPUT_ERR) 363 tag="smd:veloc:input" 364 if (.not.rtdb_cput(rtdb,tag,1,token)) 365 > call errquit(pname//'failed to store'//tag,0, 366 > RTDB_ERR) 367 368 goto 2 369 endif 370c 371c output files 372c ----------- 373 if(inp_compare(.false.,'output',token) ) then 374 if(.not.inp_a(token)) 375 > call errquit(pname//' input ',0,INPUT_ERR) 376 tag="smd:veloc:output" 377 if (.not.rtdb_cput(rtdb,tag,1,token)) 378 > call errquit(pname//'failed to store'//tag,0, 379 > RTDB_ERR) 380 381 goto 2 382 endif 383 384 385200 continue 386 write(luout,*) "out ",pname 387 return 388 end 389 390 subroutine smd_input_charge(rtdb) 391c 392 implicit none 393#include "errquit.fh" 394#include "stdio.fh" 395#include "mafdecls.fh" 396#include "inp.fh" 397#include "rtdb.fh" 398c 399 integer rtdb 400c 401 character*32 tag 402 character*32 pname 403 character*255 token 404 integer ip,np 405c 406 pname = "smd_input_charge" 407c 408 write(luout,*) "in ",pname 409c 410 np = inp_n_field() 411c 412 if(np.eq.1) goto 200 413c 414 call inp_set_field(1) 415c 416c start parsing input 417c ------------------ 4182 continue 419 if(inp_cur_field().eq.np) return 420 if (.not.inp_a(token)) 421 + call errquit(pname,0, INPUT_ERR) 422 write(*,*) "current token",token, 423 + inp_cur_field(),np 424c 425c input files 426c ----------- 427 if(inp_compare(.false.,'input',token) ) then 428 if(.not.inp_a(token)) 429 > call errquit(pname//' input ',0,INPUT_ERR) 430 tag="smd:charge:input" 431 if (.not.rtdb_cput(rtdb,tag,1,token)) 432 > call errquit(pname//'failed to store'//tag,0, 433 > RTDB_ERR) 434 435 goto 2 436 endif 437c 438c output files 439c ----------- 440 if(inp_compare(.false.,'output',token) ) then 441 if(.not.inp_a(token)) 442 > call errquit(pname//' input ',0,INPUT_ERR) 443 tag="smd:charge:output" 444 if (.not.rtdb_cput(rtdb,tag,1,token)) 445 > call errquit(pname//'failed to store'//tag,0, 446 > RTDB_ERR) 447 448 goto 2 449 endif 450 451 452200 continue 453 write(luout,*) "out ",pname 454 return 455 end 456c $Id$ 457