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