From d3a7ebdebce2b53b065a388e8be55a6eeaecd7b3 Mon Sep 17 00:00:00 2001 From: Edoardo Apra Date: Wed, 22 Feb 2017 21:15:43 +0000 Subject: [PATCH] cphf_fname --- src/cphf/cphf_poliz.F | 4 ++-- src/cphf/cphf_solve.F | 4 ++-- src/cphf/cphf_solve2.F | 4 ++-- src/cphf/cphf_solve3.F | 20 ++++++++------------ src/cphf/cphf_solve4.F | 4 ++-- 5 files changed, 16 insertions(+), 20 deletions(-) diff --git a/src/cphf/cphf_poliz.F b/src/cphf/cphf_poliz.F index 5f6388e2ca..e2fdb30651 100644 --- a/src/cphf/cphf_poliz.F +++ b/src/cphf/cphf_poliz.F @@ -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) diff --git a/src/cphf/cphf_solve.F b/src/cphf/cphf_solve.F index 72ab00ead1..e174874e5c 100644 --- a/src/cphf/cphf_solve.F +++ b/src/cphf/cphf_solve.F @@ -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) diff --git a/src/cphf/cphf_solve2.F b/src/cphf/cphf_solve2.F index dcc4358397..5b1ee15cae 100644 --- a/src/cphf/cphf_solve2.F +++ b/src/cphf/cphf_solve2.F @@ -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 diff --git a/src/cphf/cphf_solve3.F b/src/cphf/cphf_solve3.F index 353fc48112..a600f6de11 100644 --- a/src/cphf/cphf_solve3.F +++ b/src/cphf/cphf_solve3.F @@ -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, diff --git a/src/cphf/cphf_solve4.F b/src/cphf/cphf_solve4.F index 2f7e589ac5..1b2c8b4b78 100644 --- a/src/cphf/cphf_solve4.F +++ b/src/cphf/cphf_solve4.F @@ -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)