comp-chem/NWChem
1
0
Fork 0
mirror of https://github.com/nwchemgit/nwchem.git synced 2026-07-28 14:15:30 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Merge pull request #834 from edoapra/dadq

Browse source 
updates
This commit is contained in:
NWChem: Open Source High-Performance Computational Chemistry 2023-07-14 09:05:49 -07:00 • committed by GitHub
commit 124de33f84
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 41 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

41
src/property/task_raman.F
View file

@ -754,6 +754,7 @@ c 000000000 run properties (AORESPONSE) on displaced geom 000 START
& .false.,.false.,ramanpolfile)
if (ga_nodeid().eq.0)
& write(luout,*) 'ramanpolfile=',ramanpolfile
call raman_init_response(rtdb)
status1=ramanpol_read(
& ramanpolfile,! in: filename
@ -1240,3 +1241,43 @@ c if (begin .gt. last) go to 200
endif
return
end
subroutine raman_init_response(rtdb)
implicit none
#include "errquit.fh"
#include "mafdecls.fh"
#include "rtdb.fh"
integer rtdb
double precision gamwidth_in,freq_in
double precision freq,gamwidth
integer nfreq,aor_damp,aor_damp_in
parameter(gamwidth_in=0.007d0,freq_in=8.8559D-2,aor_damp_in=0)
logical read_fail
character*32 pname
pname='raman_init_response'
read_fail=(.not.rtdb_get(rtdb, 'aoresponse:damping', mt_int, 1,
$ aor_damp))
if(read_fail.or.(aor_damp.eq.0d0)) then
if (.not. rtdb_put(rtdb, 'aoresponse:damping', mt_int, 1,
$ aor_damp_in))
$ call errquit(pname//'rtdb_put failed', 1, RTDB_ERR)
endif
read_fail=(.not.rtdb_get(rtdb, 'aoresponse:gamwidth', mt_dbl, 1,
$ gamwidth))
if(read_fail.or.(gamwidth.eq.0d0)) then
if (.not. rtdb_put(rtdb, 'aoresponse:gamwidth', mt_dbl, 1,
$ gamwidth_in))
$ call errquit(pname//'rtdb_put failed', 1, RTDB_ERR)
endif
read_fail=.not.rtdb_get(rtdb,'aoresponse:nfreq', mt_int,1,nfreq)
if(read_fail.or.(nfreq.eq.0)) then
if (.not. rtdb_put(rtdb, 'aoresponse:nfreq', mt_int, 1,1))
$ call errquit(pname//'rtdb_put failed', 2, RTDB_ERR)
if (.not. rtdb_put(rtdb, 'aoresponse:freqlist', mt_dbl, 1,
& freq_in))
$ call errquit(pname//'rtdb_put failed', 0, RTDB_ERR)
endif
c status=rtdb_get(rtdb,'prop:aoresponse',MT_INT,1,noaoresponse)
if(.not.rtdb_put(rtdb,'prop:aoresponse',MT_INT,1,0))
$ call errquit(pname//'rtdb_put failed', 3, RTDB_ERR)
return
end