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

cphf_fname

Browse source
This commit is contained in:
Edoardo Apra 2017-02-22 21:15:43 +00:00
parent 4ec19db1ff
commit d3a7ebdebc
5 changed files with 16 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/cphf/cphf_poliz.F
View file

@ -216,14 +216,14 @@ c
call ga_copy_patch('n', g_tmp, nob+1, nmo, 1, nob,
$ g_rhs, noa*nva+1, vlen, 1, 1)
endif
call util_file_name('cphf_rhs',.true.,.true.,fname)
call cphf_fname('cphf_rhs',fname)
call ga_print(g_rhs)
if(.not.file_write_ga(fname,g_rhs))
$ call errquit('cphf_poliz: could not write cphf_rhs',1,
& UNKNOWN_ERR)
if (.not. cphf(rtdb)) call errquit('cphf_poliz: cphf?',0,
& RTDB_ERR)
call util_file_name('cphf_sol',.true.,.true.,fname)
call cphf_fname('cphf_sol',fname)
if(.not.file_read_ga(fname,g_sol))
$ call errquit('cphf_poliz: could not read cphf_rhs',1,
& INPUT_ERR)

4
src/cphf/cphf_solve.F
View file

@ -170,7 +170,7 @@ c
if(.not.ga_create(mt_dbl,vlen,1,'cphf_solve: rhs',0,1,g_grad))
$ call errquit('cphf_solve: ga_cre grad',vlen, GA_ERR)
c
call util_file_name('cphf_rhs',.false.,.false.,cphf_rhs)
call cphf_fname('cphf_rhs',cphf_rhs)
if(.not.file_read_ga(cphf_rhs, g_grad))
$ call errquit('cphf_solve: could not read cphf_rhs',1,
& INPUT_ERR)
@ -290,7 +290,7 @@ c$$$ $ /,15x,'UHF Polarizability is:',f16.6,
c$$$ $ /,15x,40('-'),/)
c$$$ endif
c
call util_file_name('cphf_sol',.false.,.false.,cphf_sol)
call cphf_fname('cphf_sol',cphf_sol)
if(.not.file_write_ga(cphf_sol,g_work))
$ call errquit('cphf_solve: could not write cphf_sol',1,
& UNKNOWN_ERR)

4
src/cphf/cphf_solve2.F
View file

@ -159,7 +159,7 @@ c I changed that so that we can set this by input
if (.not. rtdb_get(rtdb,'cphf:maxiter', mt_int, 1,
$ maxiter)) maxiter = 50
call util_file_name('cphf_rhs',.false.,.false.,cphf_rhs)
call cphf_fname('cphf_rhs',cphf_rhs)
if (.not. file_read_ga_info(cphf_rhs, rhs_title, ncol, nvec1))
$ call errquit('cphf_solve: reading rhs info failed?',0,
& UNKNOWN_ERR)
@ -407,7 +407,7 @@ c$$$ 911 format(//,15x,40('-'),
c$$$ $ /,15x,'UHF Polarizability is:',f16.6,
c$$$ $ /,15x,40('-'),/)
c$$$ endif
call util_file_name('cphf_sol',.false.,.false.,cphf_sol)
call cphf_fname('cphf_sol',cphf_sol)
if (ndata.eq.2) then
c == copy solution (g_work) --> g_grad 2nd subspace===START
shift=3 ! skip first subspace that corresponds to g_b

20
src/cphf/cphf_solve3.F
View file

@ -220,12 +220,12 @@ c
c
c ... jochen: open second rhs file first and check if it has data
if (ncomp.gt.1) then
call util_file_name('cphf_rhs_2',.false.,.false.,cphf_rhs(2))
call cphf_fname('cphf_rhs_2',cphf_rhs(2))
if (.not. file_read_ga_info(cphf_rhs(2),rhs_title,ncol,nvec))
$ call errquit('cphf_solve3: reading rhs 2 info failed?',0,
& UNKNOWN_ERR)
endif
call util_file_name('cphf_rhs',.false.,.false.,cphf_rhs(1))
call cphf_fname('cphf_rhs',cphf_rhs(1))
if (.not. file_read_ga_info(cphf_rhs(1), rhs_title, ncol, nvec))
$ call errquit('cphf_solve3: reading rhs info failed?',0,
& UNKNOWN_ERR)
@ -236,16 +236,14 @@ c
c ... jochen: open data file(s) with "imaginary" data
if (lifetime) then
if (ncomp.gt.1) then
call util_file_name('cphf_rhs_im_2',.false.,.false.,
+ cphf_rhs_im(2))
call cphf_fname('cphf_rhs_im_2',cphf_rhs_im(2))
if (.not. file_read_ga_info(cphf_rhs_im(2), rhs_title,
+ ncol, nvec))
$ call errquit
& ('cphf_solve3: reading rhs_im 2 info failed?',0,
& UNKNOWN_ERR)
endif
call util_file_name('cphf_rhs_im',.false.,.false.,
+ cphf_rhs_im(1))
call cphf_fname('cphf_rhs_im',cphf_rhs_im(1))
if (.not. file_read_ga_info(cphf_rhs_im(1), rhs_title,
+ ncol, nvec))
$ call errquit('cphf_solve3: reading rhs_im 1 info failed?',0,
@ -757,27 +755,25 @@ c !!! BGJ
$ call errquit('cphf_solve3: rtdb_put of j_derfit failed',0,
& RTDB_ERR)
c ======== writing (g_b,g_rhs_sol) ======== START
call util_file_name('cphf_sol',.false.,.false.,cphf_sol(1))
call cphf_fname('cphf_sol',cphf_sol(1))
if(.not.file_write_ga(cphf_sol(1),g_work(1)))
$ call errquit('cphf_solve3: could not write cphf_sol',1,
& UNKNOWN_ERR)
c ... jochen: also write second component of solution vector to file
if (ncomp.gt.1) then
call util_file_name('cphf_sol_2',.false.,.false.,cphf_sol(2))
call cphf_fname('cphf_sol_2',cphf_sol(2))
if(.not.file_write_ga(cphf_sol(2),g_work(2)))
$ call errquit('cphf_solve3: could not write cphf_sol',2,
& UNKNOWN_ERR)
endif
c ... jochen: and write imaginary parts to file as well
if (lifetime) then
call util_file_name('cphf_sol_im',.false.,.false.,
& cphf_sol_im(1))
call cphf_fname('cphf_sol_im',cphf_sol_im(1))
if(.not.file_write_ga(cphf_sol_im(1),g_work_im(1)))
$ call errquit('cphf_solve3: could not write cphf_sol_im',1,
& UNKNOWN_ERR)
if (ncomp.gt.1) then
call util_file_name('cphf_sol_im_2',.false.,.false.,
& cphf_sol_im(2))
call cphf_fname('cphf_sol_im_2',cphf_sol_im(2))
if(.not.file_write_ga(cphf_sol_im(2),g_work_im(2)))
$ call errquit
& ('cphf_solve3: could not write cphf_sol_im_2',1,

4
src/cphf/cphf_solve4.F
View file

@ -142,7 +142,7 @@ c
if (.not. rtdb_get(rtdb, 'cphf:maxiter', mt_int, 1,
$ max_precond_iter)) max_precond_iter = 100
c
call util_file_name('cphf_rhs',.false.,.false.,cphf_rhs)
call cphf_fname('cphf_rhs',cphf_rhs)
if (.not. file_read_ga_info(cphf_rhs, rhs_title, ncol, nvec))
$ call errquit('cphf_solve: reading rhs info failed?',0,
& UNKNOWN_ERR)
@ -319,7 +319,7 @@ c$$$ $ /,15x,'UHF Polarizability is:',f16.6,
c$$$ $ /,15x,40('-'),/)
c$$$ endif
c
call util_file_name('cphf_sol',.false.,.false.,cphf_sol)
call cphf_fname('cphf_sol',cphf_sol)
if(.not.file_write_ga(cphf_sol,g_work))
$ call errquit('cphf_solve: could not write cphf_sol',1,
& UNKNOWN_ERR)