1 subroutine rel_input(rtdb) 2* 3* $Id: rel_input.F 21948 2012-02-03 19:27:57Z niri $ 4* 5 implicit none 6#include "rtdb.fh" 7#include "context.fh" 8#include "global.fh" 9#include "mafdecls.fh" 10#include "inp.fh" 11#include "util.fh" 12#include "stdio.fh" 13#include "rel_consts.fh" 14#include "errquit.fh" 15#include "zora.fh" 16#include "modelpotential.fh" 17c 18c Read input for the relativistic block 19c 20 integer rtdb ! [input] handle to database 21 integer slc_spinpolAO ! for selecting spin-density matrix contrib 22c 23 character*255 test 24 double precision clight 25 logical dk_run ! Douglas-Kroll 26 logical dmd_run ! Dyall modified Dirac 27 logical zora_run ! ZORA 28 integer mpoption 29c 30 logical status 31 integer irelKey ! Relativistic method keys 32 logical do_prntNMRCS 33 logical skip_csAOev,skip_gshiftAOev, 34 & skip_hypAOev,skip_efgz4AOev, 35 & Knucl 36 logical skip_cphf_ev_shield, 37 & skip_cphf_ev_gshift, 38 & skip_cphf_ev_hyp 39 40 irelKey = 0 41c 42c Set the available relativistic approaches to .false. 43c 44c Douglas-Kroll 45 dk_run = .false. 46 if (.not. rtdb_put(rtdb, 'doug_kroll', mt_log, 1, dk_run)) 47 $ call errquit('rel_input: rtdb_put failed', 0, RTDB_ERR) 48c 49c Dyall Modified Dirac 50 dmd_run = .false. 51 if (.not. rtdb_put(rtdb, 'dyall_mod_dir', mt_log, 1, dmd_run)) 52 $ call errquit('rel_input: rtdb_put failed', 0, RTDB_ERR) 53c 54c ZORA 55 zora_run = .false. 56 if (.not. rtdb_put(rtdb, 'zora', mt_log, 1, zora_run)) 57 & call errquit('rel_input: rtdb_put failed', 0, RTDB_ERR) 58c 59c Set some relativistic variables we could need later on 60c 61 1 if (.not. inp_read()) call errquit('rel_input: inp_read failed',0, 62 & INPUT_ERR) 63 if (.not. inp_a(test)) 64 $ call errquit('rel_input: failed to read keyword', 0, 65 & INPUT_ERR) 66c 67 if (inp_compare(.false.,'clight', test)) then 68c 69 if (.not. inp_f(clight)) then 70 call errquit('rel_input: failed reading clight', 0, 71 & UNKNOWN_ERR) 72 else 73 if(.not.rtdb_put(rtdb,'relativistic:clight',mt_dbl,1,clight)) 74 $ call errquit('rel_input: rtdb_put failed', 0, RTDB_ERR) 75 endif 76 write(luout,10) clight 77 10 format(/,'The speed of light used in the relativistic ', 78 $ 'calculations is ',F16.10, 'au.'/) 79c 80 elseif (inp_compare(.false.,'douglas-kroll', test)) then 81 dk_run = .true. 82 if (.not. rtdb_put(rtdb, 'doug_kroll', mt_log, 1, dk_run)) 83 $ call errquit('rel_input: rtdb_put failed', 0, RTDB_ERR) 84 call dk_input(rtdb) 85c 86 elseif (inp_compare(.false.,'dyall-mod-dirac', test)) then 87 dmd_run = .true. 88 if (.not. rtdb_put(rtdb, 'dyall_mod_dir', mt_log, 1, dmd_run)) 89 $ call errquit('rel_input: rtdb_put failed', 0, RTDB_ERR) 90 call dmd_input(rtdb) 91c 92 elseif (inp_compare(.false.,'zora', test)) then 93 call zora_input(rtdb) 94c 95 elseif (inp_compare(.false.,'modelpotential', test)) then 96 use_modelpotential = .true. 97 if (.not. rtdb_put(rtdb, 'modelpotential', mt_log, 1, 98 & use_modelpotential)) 99 & call errquit('rel_input: rtdb_put failed', 0, RTDB_ERR) 100 if (.not. inp_i(mpoption)) mpoption = 1 ! default is modbas.4c 101 if (.not. rtdb_put(rtdb,'modelpotential:option', 102 & mt_int,1,mpoption)) 103 & call errquit('rel_input: rtdb_put failed', 0, RTDB_ERR) 104 call modelpotential_input(rtdb) 105c 106 elseif(inp_compare(.false.,'zora:cutoff',test)) then 107 if(.not. inp_f(zoracutoff)) zoracutoff = 1.0d-15 ! set a default cutoff 108 if (.not. rtdb_put(rtdb,'zora:cutoff',mt_dbl,1,zoracutoff)) 109 & call errquit('rel_input: rtdb put failed',0, RTDB_ERR) 110c 111c zoracutoff_EFG, used in get_rhoS() from dft_zora_utils.F 112 elseif(inp_compare(.false.,'zora:cutoff_EFG',test)) then 113 if(.not. inp_f(zoracutoff_EFG)) zoracutoff_EFG = 1.0d-04 ! set dflt cutoff 114 if (.not. rtdb_put(rtdb,'zora:cutoff_EFG', 115 & mt_dbl,1,zoracutoff_EFG)) 116 & call errquit('rel_input: rtdb put failed',0, RTDB_ERR) 117c 118c zoracutoff_NMR, used in get_NMR() from dft_zora_utils.F 119 elseif(inp_compare(.false.,'zora:cutoff_NMR',test)) then 120 if(.not. inp_f(zoracutoff_NMR)) zoracutoff_NMR = 1.0d-08 ! set dflt cutoff 121 if (.not. rtdb_put(rtdb,'zora:cutoff_NMR', 122 & mt_dbl,1,zoracutoff_NMR)) 123 & call errquit('rel_input: rtdb put failed',0, RTDB_ERR) 124c 125 elseif(inp_compare(.false.,'zora:do_NonRel',test)) then 126 do_NonRel = .true. ! set do_NonRel 127 if (.not. rtdb_put(rtdb,'zora:do_NonRel', mt_log,1,do_NonRel)) 128 & call errquit('rel_input: rtdb put failed',0, RTDB_ERR) 129c 130 elseif(inp_compare(.false.,'zora:do_prntNMRCS',test)) then 131 do_prntNMRCS = .true. ! set do_prntNMRCS 132 if (.not. rtdb_put(rtdb,'zora:do_prntNMRCS', 133 & mt_log,1,do_prntNMRCS)) 134 & call errquit('rel_input: rtdb put failed',0, RTDB_ERR) 135c 136 elseif(inp_compare(.false.,'zora:not_zora_scale',test)) then 137 not_zora_scale = .true. ! set not_zora_scale 138 if (.not. rtdb_put(rtdb,'zora:not_zora_scale', 139 & mt_log,1,not_zora_scale)) 140 & call errquit('rel_input: rtdb put failed',0, RTDB_ERR) 141c 142c ------- SKIP ev. AO matrices for NMRCS or gshifts or hyperfine 143c Note.- It will read instead data from a file, if the file does not 144c exist it will stop calc. with a warning message. 145 elseif(inp_compare(.false.,'zora:skip_csAOev',test)) then 146 skip_csAOev = .true. 147 if (.not. rtdb_put(rtdb,'zora:skip_csAOev', 148 & mt_log,1,skip_csAOev)) 149 & call errquit('rel_input: rtdb put failed skip csAOev', 150 & 0, RTDB_ERR) 151 elseif(inp_compare(.false.,'zora:skip_gshiftAOev',test)) then 152 skip_gshiftAOev = .true. 153 if (.not. rtdb_put(rtdb,'zora:skip_gshiftAOev', 154 & mt_log,1,skip_gshiftAOev)) 155 & call errquit('rel_input: rtdb put failed skip gshiftAOev', 156 & 0, RTDB_ERR) 157 elseif(inp_compare(.false.,'zora:skip_hypAOev',test)) then 158 skip_hypAOev = .true. 159 if (.not. rtdb_put(rtdb,'zora:skip_hypAOev', 160 & mt_log,1,skip_hypAOev)) 161 & call errquit('rel_input: rtdb put failed skip hypAOev', 162 & 0, RTDB_ERR) 163 elseif(inp_compare(.false.,'zora:skip_efgz4AOev',test)) then 164 skip_efgz4AOev = .true. 165 if (.not. rtdb_put(rtdb,'zora:skip_efgz4AOev', 166 & mt_log,1,skip_efgz4AOev)) 167 & call errquit('rel_input: rtdb put failed skip efgz4AOev', 168 & 0, RTDB_ERR) 169c 170c definitions for skip-cphf flags 171 elseif(inp_compare(.false.,'zora:skip_cphf_ev_shield',test)) then 172 skip_cphf_ev_shield = .true. 173 if (.not. rtdb_put(rtdb,'zora:skip_cphf_ev_shield', 174 & mt_log,1,skip_cphf_ev_shield)) 175 & call errquit('rel_input-1: rtdb put failed skip cphf shield ', 176 & 0, RTDB_ERR) 177 elseif(inp_compare(.false.,'zora:skip_cphf_ev_gshift',test)) then 178 skip_cphf_ev_gshift = .true. 179 if (.not. rtdb_put(rtdb,'zora:skip_cphf_ev_gshift', 180 & mt_log,1,skip_cphf_ev_gshift)) 181 & call errquit('rel_input-2: rtdb put failed skip cphf gshift', 182 & 0, RTDB_ERR) 183 elseif(inp_compare(.false.,'zora:skip_cphf_ev_hyp',test)) then 184 skip_cphf_ev_hyp = .true. 185 if (.not. rtdb_put(rtdb,'zora:skip_cphf_ev_hyp', 186 & mt_log,1,skip_cphf_ev_hyp)) 187 & call errquit('rel_input-3: rtdb put failed skip cphf hyp', 188 & 0, RTDB_ERR) 189c 190 elseif(inp_compare(.false.,'zora:Knucl',test)) then 191c Knucle purpose: For including ONLY nuclear part in evaluation of K ZORA 192 Knucl = .true. 193 if (.not. rtdb_put(rtdb,'zora:Knucl', 194 & mt_log,1,Knucl)) 195 & call errquit('rel_input: rtdb put failed Knucl', 196 & 0, RTDB_ERR) 197 elseif(inp_compare(.false.,'zora:slc_spinpolAO',test)) then 198c For selecting spin-density matrix (A-B means total spin density matrix) 199c 0=A-B,1=A,2=-B selecting spin-density matrix 200 if (.not. inp_i(slc_spinpolAO)) slc_spinpolAO= 0 ! set a default 201 if (.not. rtdb_put(rtdb,'zora:slc_spinpolAO', 202 & mt_int,1,slc_spinpolAO)) 203 & call errquit('rel_input: rtdb put failed',0, RTDB_ERR) 204 else if (inp_compare(.false.,'end', test)) then 205c 206c end will be catched in while loop structure 207c 208 else 209 call errquit('rel_input: unrecognized directive', 0, INPUT_ERR) 210 endif 211c 212c End of while loop over the input 213c 214 if (.not. inp_compare(.false.,'end', test)) goto 1 215c 216c User could have set multiple relativistic approaches in the input file by accident. 217c Check if this is the case, stop if multiple methods are set to true. 218c 219 irelKey = 0 220 status = rtdb_get(rtdb, 'doug_kroll', mt_log, 1, dk_run) 221 if (dk_run) irelKey = irelKey + 1 222c 223 status = rtdb_get(rtdb, 'dyall_mod_dir', mt_log, 1, dmd_run) 224 if (dmd_run) irelKey = irelKey + 1 225c 226 status = rtdb_get(rtdb, 'zora', mt_log, 1, zora_run) 227 if (zora_run) irelKey = irelKey + 1 228c 229c Check if multiple approaches have been set 230 if (irelKey .gt. 1) then 231 if (ga_nodeid() .eq. 0) then 232 write(luout,20) 233 20 format(/'Input error relativistic:'/, 234 & 'Multiple relativistic methods have been specified 235 & in the input!') 236 endif 237 call errquit('rel_input: input error',0, INPUT_ERR) 238 endif 239 240 return 241 end 242