1 block data initial_smd_energy_data 2 implicit none 3#include "smd_energy_data.fh" 4c 5 data smd_energy_name /"total", 6 c "kinetic", 7 c "vdw", 8 c "electrostatic", 9 c "ewald self", 10 c "ewald reciprocal", 11 c "ewald excluded", 12 c "ewald real"/ 13 14 15 end 16 17 subroutine smd_energy_init_system() 18 implicit none 19#include "errquit.fh" 20#include "inp.fh" 21#include "mafdecls.fh" 22#include "rtdb.fh" 23#include "util.fh" 24#include "global.fh" 25c 26 character*32 sp_energy 27 character*32 tag,pname 28 logical result 29 30 pname = "smd_energy_init_system" 31c 32 tag = "energy" 33 call smd_system_get_component(sp_energy,tag,result) 34 if(.not.result) 35 > call errquit( 36 > pname//'no component '//tag,0,0) 37 38 call smd_energy_init(sp_energy) 39 40 return 41 end 42 43 subroutine smd_energy_init(sp_energy) 44 implicit none 45#include "errquit.fh" 46#include "inp.fh" 47#include "mafdecls.fh" 48#include "rtdb.fh" 49#include "util.fh" 50#include "global.fh" 51#include "smd_energy_data.fh" 52c 53 character*(*) sp_energy 54c 55 character*32 pname 56 integer na 57c 58 pname = "smd_energy_init" 59c 60c write(*,*) "in "//pname 61c 62c create energy data structures 63c --------------------------- 64 call smd_namespace_create(sp_energy) 65 call smd_data_create(sp_energy,"energy",smd_energy_nc,MT_DBL) 66 call smd_data_create(sp_energy,"oenergy",smd_energy_nc,MT_LOG) 67 return 68 end 69 70 subroutine smd_energy_set_component(aname,avalue) 71 implicit none 72#include "errquit.fh" 73#include "inp.fh" 74#include "mafdecls.fh" 75#include "rtdb.fh" 76#include "global.fh" 77#include "smd_energy_data.fh" 78c 79 character*(*) aname 80 double precision avalue 81c 82 character*32 pname 83 integer nrec 84 integer i 85 logical result 86 logical ocase 87 integer i_e 88 integer i_oe 89 character*32 sp_energy 90 character*32 tag 91c 92 pname = "smd_energy_set_component" 93c 94 write(*,*) "in "//pname 95c 96 call smd_system_get_component(sp_energy,"energy",result) 97 if(.not.result) 98 > call errquit( 99 > pname//'no energy ',0,0) 100 101 tag = "energy" 102 call smd_data_get_index(sp_energy,tag,i_e,result) 103 if(.not. result) 104 > call errquit( 105 > pname//'error getting index for '//tag,0, RTDB_ERR) 106 tag = "oenergy" 107 call smd_data_get_index(sp_energy,tag,i_oe,result) 108 if(.not. result) 109 > call errquit( 110 > pname//'error getting index for '//tag,0, RTDB_ERR) 111 112c 113c case sensitive 114 ocase = .true. 115c 116 nrec = smd_energy_nc 117c 118 tag = aname 119 result = inp_match(nrec,ocase,aname,smd_energy_name,i) 120 if(.not. result) 121 > call errquit( 122 > pname//'no component '//tag,0, RTDB_ERR) 123 124 dbl_mb(i_e+i-1) = avalue 125 log_mb(i_oe+i-1) = .true. 126 127 return 128 end 129 130 subroutine smd_energy_unset_component(aname) 131 implicit none 132#include "errquit.fh" 133#include "inp.fh" 134#include "mafdecls.fh" 135#include "rtdb.fh" 136#include "global.fh" 137#include "smd_energy_data.fh" 138c 139 character*(*) aname 140c 141 character*32 pname 142 integer nrec 143 integer i 144 logical result 145 logical ocase 146 integer i_e 147 integer i_oe 148 character*32 sp_energy 149 character*32 tag 150cc 151 pname = "smd_energy_set_component" 152c 153 write(*,*) "in "//pname 154c 155 call smd_system_get_component(sp_energy,"energy",result) 156 if(.not.result) 157 > call errquit( 158 > pname//'no energy ',0,0) 159 160 tag = "energy" 161 call smd_data_get_index(sp_energy,tag,i_e,result) 162 if(.not. result) 163 > call errquit( 164 > pname//'error getting index for '//tag,0, RTDB_ERR) 165 tag = "oenergy" 166 call smd_data_get_index(sp_energy,tag,i_oe,result) 167 if(.not. result) 168 > call errquit( 169 > pname//'error getting index for '//tag,0, RTDB_ERR) 170c 171c case sensitive 172 ocase = .true. 173c 174 nrec = smd_energy_nc 175c 176 tag = aname 177 result = inp_match(nrec,ocase,aname,smd_energy_name,i) 178 if(.not. result) 179 > call errquit( 180 > pname//'no component '//tag,0, RTDB_ERR) 181 182 log_mb(i_oe+i-1) = .false. 183 dbl_mb(i_e+i-1) = 0.0d0 184 185 return 186 end 187 188 subroutine smd_energy_get_component(avalue,aname,oexist) 189 implicit none 190#include "errquit.fh" 191#include "inp.fh" 192#include "mafdecls.fh" 193#include "rtdb.fh" 194#include "global.fh" 195#include "smd_energy_data.fh" 196c 197 character*(*) aname 198 double precision avalue 199c 200 character*32 pname 201 integer nrec 202 integer i 203 logical oexist,result 204 logical ocase 205 integer i_e 206 integer i_oe 207 character*32 sp_energy 208 character*32 tag 209c 210 pname = "smd_energy_get_component" 211c 212 write(*,*) "in "//pname 213c 214 call smd_system_get_component(sp_energy,"energy",result) 215 if(.not.result) 216 > call errquit( 217 > pname//'no energy ',0,0) 218 219 tag = "energy" 220 call smd_data_get_index(sp_energy,tag,i_e,result) 221 if(.not. result) 222 > call errquit( 223 > pname//'error getting index for '//tag,0, RTDB_ERR) 224 tag = "oenergy" 225 call smd_data_get_index(sp_energy,tag,i_oe,result) 226 if(.not. result) 227 > call errquit( 228 > pname//'error getting index for '//tag,0, RTDB_ERR) 229c 230c case sensitive 231 ocase = .true. 232c 233 nrec = smd_energy_nc 234c 235 tag = aname 236 result = inp_match(nrec,ocase,aname,smd_energy_name,i) 237 if(.not. result) 238 > call errquit( 239 > pname//'no component '//tag,0, RTDB_ERR) 240 241 avalue = dbl_mb(i_e+i-1) 242 oexist = log_mb(i_oe+i-1) 243 244 return 245 end 246 247 subroutine smd_energy_print(un) 248 implicit none 249#include "errquit.fh" 250#include "inp.fh" 251#include "mafdecls.fh" 252#include "rtdb.fh" 253#include "global.fh" 254#include "smd_energy_data.fh" 255c 256 integer un 257c 258 character*32 pname 259 integer nrec 260 integer i 261 logical oexist,result 262 logical ocase 263 integer i_e 264 integer i_oe 265 character*32 sp_energy 266 character*32 tag 267c 268 pname = "smd_energy_print" 269c 270 write(*,*) "in "//pname 271c 272 call smd_system_get_component(sp_energy,"energy",result) 273 if(.not.result) 274 > call errquit( 275 > pname//'no energy ',0,0) 276 277 tag = "energy" 278 call smd_data_get_index(sp_energy,tag,i_e,result) 279 if(.not. result) 280 > call errquit( 281 > pname//'error getting index for '//tag,0, RTDB_ERR) 282 tag = "oenergy" 283 call smd_data_get_index(sp_energy,tag,i_oe,result) 284 if(.not. result) 285 > call errquit( 286 > pname//'error getting index for '//tag,0, RTDB_ERR) 287c 288 do i=1,smd_energy_nc 289 oexist = log_mb(i_oe+i-1) 290 if(oexist) 291 > write(un,'(A16," : ", F12.6)') 292 > smd_energy_name(i),dbl_mb(i_e+i-1) 293 end do 294 write(91,*) dbl_mb(i_e),dbl_mb(i_e+3),dbl_mb(i_e+2) 295 296 return 297 end 298 299 subroutine smd_energy_compute() 300 implicit none 301#include "errquit.fh" 302#include "inp.fh" 303#include "mafdecls.fh" 304#include "rtdb.fh" 305#include "global.fh" 306#include "smd_energy_data.fh" 307c 308 integer un 309c 310 character*32 pname 311 integer nrec 312 integer i 313 logical oexist,result 314 logical ocase 315 integer i_e 316 integer i_oe 317 character*32 sp_energy 318 character*32 tag 319c 320 pname = "smd_energy_compute" 321c 322 write(*,*) "in "//pname 323c 324 call smd_system_get_component(sp_energy,"energy",result) 325 if(.not.result) 326 > call errquit( 327 > pname//'no energy ',0,0) 328 329 tag = "energy" 330 call smd_data_get_index(sp_energy,tag,i_e,result) 331 if(.not. result) 332 > call errquit( 333 > pname//'error getting index for '//tag,0, RTDB_ERR) 334 tag = "oenergy" 335 call smd_data_get_index(sp_energy,tag,i_oe,result) 336 if(.not. result) 337 > call errquit( 338 > pname//'error getting index for '//tag,0, RTDB_ERR) 339c 340 dbl_mb(i_e+3) = 0.0d0 341 do i=5,8 342 dbl_mb(i_e+3) = dbl_mb(i_e+3)+ dbl_mb(i_e+i-1) 343 end do 344 log_mb(i_oe+3) = .true. 345 346 dbl_mb(i_e) = 0.0d0 347 do i=2,4 348 dbl_mb(i_e) = dbl_mb(i_e)+ dbl_mb(i_e+i-1) 349 end do 350 log_mb(i_oe) = .true. 351 352 return 353 end 354 355c $Id$ 356