1c 2c QMD NAMD input handler 3c 4 subroutine qmd_namd_input(rtdb) 5c 6c NAMD 7c END 8c 9 implicit none 10c 11#include "errquit.fh" 12#include "global.fh" 13#include "rtdb.fh" 14#include "geom.fh" 15#include "mafdecls.fh" 16#include "bas.fh" 17#include "inp.fh" 18#include "stdio.fh" 19#include "case.fh" 20c 21 integer rtdb 22c 23 integer nstates 24 integer state 25 integer ks_spin 26 double precision dt_elec 27 logical do_tdks 28 logical deco 29c 30 character*32 test 31 character*30 pname 32c 33 pname = "qmd_namd_input: " 34c 35c ------------------ 36c Set default values 37c ------------------ 38c 39c Electronic dynamics time step: dt_elec 40 dt_elec = 0.01d0 41 if (.not.rtdb_put(rtdb,'qmd:dt_elec',mt_dbl,1,dt_elec)) 42 & call errquit(pname//'failed to write dt_elec',0,RTDB_ERR) 43c 44c Number of states 45 nstates = 2 46 if (.not.rtdb_put(rtdb,'qmd:nstates',mt_int,1,nstates)) 47 & call errquit(pname//'failed to write nstates',0,RTDB_ERR) 48c 49c Initial state 50c corresponds to first excited state 51 state = 2 52 if (.not.rtdb_put(rtdb,'qmd:init_state',mt_int,1,state)) 53 & call errquit(pname//'failed to write state',0,RTDB_ERR) 54c 55c decoherence flag 56 deco = .false. 57 if (.not.rtdb_put(rtdb,'qmd:deco',mt_log,1,deco)) 58 & call errquit(pname//'failed to write deco',0,RTDB_ERR) 59c 60c TDKS flag 61 do_tdks = .false. 62 if (.not.rtdb_put(rtdb,'qmd:tdks',mt_log,1,do_tdks)) 63 & call errquit(pname//'failed to write do_tdks',0,RTDB_ERR) 64c 65c TDKS spin channel 66 ks_spin = 1 67 if (.not.rtdb_put(rtdb,'qmd:ks_spin',mt_int,1,ks_spin)) 68 & call errquit(pname//'failed to write ks_spin',0,RTDB_ERR) 69c 70c ---------- 71c Read input 72c ---------- 73c 74 10 if (.not. inp_read()) 75 1 call errquit(pname//'failed reading input',0,INPUT_ERR) 76 if (.not. inp_a(test)) 77 1 call errquit(pname//'failed reading keyword',0,INPUT_ERR) 78c 79c Electronic dynamics time step: dt_elec 80 if (inp_compare(.false.,test,'dt_elec')) then 81 if (.not.inp_f(dt_elec)) then 82 write(luOut,*) 'dt_elec: value not found; ', 83 1 'default value of 0.01d0 will be used' 84 dt_elec = 0.01d0 85 endif 86 if (.not.rtdb_put(rtdb,'qmd:dt_elec',mt_dbl,1,dt_elec)) 87 & call errquit(pname//'failed to write dt_elec',0,RTDB_ERR) 88c 89c Number of states 90 else if (inp_compare(.false.,test,'nstates')) then 91 if (.not.inp_i(nstates)) then 92 write(luOut,*) 'nstates: value not found; ', 93 1 'default value of 2 will be used' 94 nstates=2 95 end if 96 if (.not.rtdb_put(rtdb,'qmd:nstates',mt_int,1,nstates)) 97 & call errquit(pname//'failed to write nstates',0, 98 & RTDB_ERR) 99c 100c Initial state 101 else if (inp_compare(.false.,test,'init_state')) then 102 if (.not.inp_i(state)) then 103 write(luOut,*) 'init_state: value not found; ', 104 1 'default value of 1 will be used' 105 state=1 106 end if 107c For input/output state runs from 0 to nstates-1 108c inside the code state runs from 1 to nstates 109 state=state+1 110 if (.not.rtdb_put(rtdb,'qmd:init_state',mt_int,1,state)) 111 & call errquit(pname//'failed to write state',0, 112 & RTDB_ERR) 113c 114c Decoherence? 115 else if (inp_compare(.false.,test,'deco')) then 116 deco=.true. 117 if (.not.rtdb_put(rtdb,'qmd:deco',mt_log,1,deco)) 118 & call errquit(pname//'failed to write deco',0,RTDB_ERR) 119c 120c TDKS? 121 else if (inp_compare(.false.,test,'tdks')) then 122 do_tdks=.true. 123 if (.not.rtdb_put(rtdb,'qmd:tdks',mt_log,1,do_tdks)) 124 & call errquit(pname//'failed to write do_tdks',0,RTDB_ERR) 125 if (.not.inp_i(ks_spin)) then 126 write(luOut,*) 'tdks: value not found; ', 127 1 'default value of 1 will be used' 128 ks_spin=1 129 end if 130 if (.not.rtdb_put(rtdb,'qmd:ks_spin',mt_int,1,ks_spin)) 131 & call errquit(pname//'failed to write ks_spin',0, 132 & RTDB_ERR) 133c 134c END 135 else if (inp_compare(.false.,test,'end')) then 136 goto 20 137c 138 else 139 call errquit(pname//'unknown directive',0, INPUT_ERR) 140 endif 141 goto 10 142c 143c ------ 144c Return 145c ------ 146c 147 20 return 148 end 149