From 7440b20ccd564914c131397b9f6686ea75dda47c Mon Sep 17 00:00:00 2001 From: Jochen Autschbach Date: Thu, 27 Jan 2022 10:44:13 -0500 Subject: [PATCH 01/15] initial addition of scalar x2c functionality. some cleanup still to be done --- src/NWints/api/apiP.fh | 7 + src/NWints/api/exact_mem.F | 13 + src/NWints/api/int_init.F | 44 +- src/NWints/api/int_term.F | 8 + src/NWints/rel/GNUmakefile | 6 +- src/NWints/rel/rel_input.F | 20 +- src/NWints/rel/x2c.fh | 15 + src/NWints/rel/x2c_input.F | 91 +++ src/nwdft/GNUmakefile | 2 +- src/nwdft/scf_dft/dft_fockbld.F | 29 +- src/nwdft/scf_dft/dft_main0d.F | 12 + src/nwdft/scf_dft/dft_scf.F | 203 ++++- src/nwdft/x2c/GNUmakefile | 27 + src/nwdft/x2c/calc_x2c_1e_scalar_ga.F | 969 ++++++++++++++++++++++++ src/nwdft/x2c/calc_x2c_efg_scalar.F | 712 +++++++++++++++++ src/nwdft/x2c/calc_x2c_moment_scalar.F | 507 +++++++++++++ src/nwdft/x2c/calc_x2c_w_scalar.F | 189 +++++ src/nwdft/x2c/calc_x2c_wefg_scalar.F | 152 ++++ src/nwdft/x2c/calc_x2c_wmoment_scalar.F | 157 ++++ src/nwdft/x2c/read_x2c_pc_dip.F | 50 ++ src/nwdft/x2c/write_x2c_pc_dip.F | 41 + src/nwdft/x2c/x2c_getw_efg_scalar.F | 266 +++++++ src/nwdft/x2c/x2c_getw_moment_scalar.F | 249 ++++++ src/nwdft/x2c/x2c_getw_scalar.F | 262 +++++++ src/nwdft/zora/GNUmakefile | 1 + src/nwdft/zora/gridQpqPotential.F | 79 +- src/nwdft/zora/grid_moments.F | 57 ++ 27 files changed, 4124 insertions(+), 44 deletions(-) create mode 100644 src/NWints/rel/x2c.fh create mode 100644 src/NWints/rel/x2c_input.F create mode 100644 src/nwdft/x2c/GNUmakefile create mode 100644 src/nwdft/x2c/calc_x2c_1e_scalar_ga.F create mode 100644 src/nwdft/x2c/calc_x2c_efg_scalar.F create mode 100644 src/nwdft/x2c/calc_x2c_moment_scalar.F create mode 100644 src/nwdft/x2c/calc_x2c_w_scalar.F create mode 100644 src/nwdft/x2c/calc_x2c_wefg_scalar.F create mode 100644 src/nwdft/x2c/calc_x2c_wmoment_scalar.F create mode 100644 src/nwdft/x2c/read_x2c_pc_dip.F create mode 100644 src/nwdft/x2c/write_x2c_pc_dip.F create mode 100644 src/nwdft/x2c/x2c_getw_efg_scalar.F create mode 100644 src/nwdft/x2c/x2c_getw_moment_scalar.F create mode 100644 src/nwdft/x2c/x2c_getw_scalar.F create mode 100644 src/nwdft/zora/grid_moments.F diff --git a/src/NWints/api/apiP.fh b/src/NWints/api/apiP.fh index 6babc80d59..85156e3b68 100644 --- a/src/NWints/api/apiP.fh +++ b/src/NWints/api/apiP.fh @@ -89,3 +89,10 @@ c common /DK_log/doug_kroll, dk_even_bas common /DK_int/dk_form_type, dk_fitbas common /DK_real/dk_ratio, dk_clight +c +c exact decoupling settings for the API (similar to DK) +c + logical exact_2c + integer x2c_bas + common /X2C_log/exact_2c + common /X2C_int/x2c_bas diff --git a/src/NWints/api/exact_mem.F b/src/NWints/api/exact_mem.F index f004fe9dc0..fe46b70f41 100644 --- a/src/NWints/api/exact_mem.F +++ b/src/NWints/api/exact_mem.F @@ -29,6 +29,7 @@ c:tex-\end{verbatim} #include "apiP.fh" #include "stdio.fh" #include "util.fh" +#include "errquit.fh" c c:: functions logical api_is_atomic_basis @@ -123,6 +124,18 @@ c isz_1e = max(isz_1e, lsz_1e) endif c +c ... jochen: +c Memory for X2C integrals. exact_2c and x2c_bas are +c common-block variables in apiP.fh + + if (exact_2c) then + if (doug_kroll) call errquit( + & 'exact_mem: x2c and DK not allowed',1,INPUT_ERR) + call emem_1e_dk(x2c_bas,x2c_bas,lsz_1e, lmem_1e) + mem_1e = max(mem_1e, lmem_1e) + isz_1e = max(isz_1e, lsz_1e) + endif +c c.. need extra memory for H1 call externalized by int_mem_h1 c mem_1e_h1 = mem_1e + isz_1e diff --git a/src/NWints/api/int_init.F b/src/NWints/api/int_init.F index 8bbd7e7713..5e1aaae582 100644 --- a/src/NWints/api/int_init.F +++ b/src/NWints/api/int_init.F @@ -55,6 +55,9 @@ c procedure. The wrapper sets the Douglas-Kroll stuff and adds the new c fitting basis set to the list of active basis sets and calls c int_init_org. c +c ... jochen 01/22: the exact decoupling functionality needs +c the same setup as Douglas-Kroll, so we added that here +c c::passed c:tex-\begin{verbatim} integer rtdb !< [Input] run time data base handle @@ -162,7 +165,46 @@ c int_mb(mybIm_a+nbas) = dk_fitbas nrbas = nrbas + 1 endif - if (doug_kroll .or. dyall_mod_dir) call rel_init_con (rtdb) + +c ... jochen 01/22: same idea as for douglas-kroll: we initialize +c an additional uncontracted basis. +c in principle we could have used the corresponding D-K code +c and variables, but I want to avoid potentially conflicting +c variable definitions + + if (.not. rtdb_get(rtdb,'x2c',MT_LOG,1,exact_2c)) + & exact_2c = .false. +c write (luout,*) 'jochen: in int_init x2c = ',exact_2c + if (exact_2c) then + + if (doug_kroll) call errquit( + & 'int_init: x2c and DK not allowed',1,INPUT_ERR) + +c Generate the fitting basis set and add it to the list of +c used basis sets + + do 300 ibas = 1, nbas + if (.not. bas_name(bases(ibas),dk_bas_name,dk_trans_name)) + & call errquit('int_init: x2c failed in bas_name',0, + & INT_ERR) + if (dk_bas_name(1:8) .eq. 'ao basis') goto 350 + 300 continue + call errquit('int_init: x2c could not find ao basis',0, + & INT_ERR) + 350 call bas_create_uncont(rtdb,bases(ibas),'auto X2C basis', + & x2c_bas) + +c Add fitting basis set to list of loaded basis sets + + int_mb(mybIm_a+nbas) = x2c_bas + nrbas = nrbas + 1 + endif ! exact_2c +c ... jochen end + +c rel_init_con initializes some relativistic constants + if (doug_kroll .or. dyall_mod_dir .or. exact_2c) + & call rel_init_con (rtdb) + call int_init_org(rtdb, nrbas, int_mb(mybIm_a)) if (.not. ma_pop_stack(mybm_a)) $ call errquit('int_init: ma_pop_stack mybm_a',0, INT_ERR) diff --git a/src/NWints/api/int_term.F b/src/NWints/api/int_term.F index 2678844691..9045b365a4 100644 --- a/src/NWints/api/int_term.F +++ b/src/NWints/api/int_term.F @@ -69,6 +69,14 @@ c & ,0, INT_ERR) dk_fitbas = -1 endif +c +c terminate uncontracted basis used in the X2C code + if (exact_2c) then + if (.not. bas_destroy(x2c_bas)) call errquit( + & 'int_terminate: failed to destroy x2c uncontracted basis' + & ,0, INT_ERR) + x2c_bas = -1 + endif c end C> diff --git a/src/NWints/rel/GNUmakefile b/src/NWints/rel/GNUmakefile index d91c1ae220..53502e9966 100644 --- a/src/NWints/rel/GNUmakefile +++ b/src/NWints/rel/GNUmakefile @@ -3,7 +3,8 @@ HEADERS = rel_consts.fh \ rel_nwc.fh \ zora.fh \ - modelpotential.fh + modelpotential.fh \ + x2c.fh OBJ_ENERGY = \ rel_onel.o \ @@ -17,7 +18,8 @@ OBJ_ENERGY = \ rel_SSSS.o \ rel_init_con.o \ dmd_input.o \ - zora_input.o + zora_input.o \ + x2c_input.o OBJ_GRAD = \ rel_oneld.o \ diff --git a/src/NWints/rel/rel_input.F b/src/NWints/rel/rel_input.F index ae2042fa24..c40339b75f 100644 --- a/src/NWints/rel/rel_input.F +++ b/src/NWints/rel/rel_input.F @@ -14,6 +14,7 @@ #include "errquit.fh" #include "zora.fh" #include "modelpotential.fh" +#include "x2c.fh" c c Read input for the relativistic block c @@ -25,6 +26,7 @@ c logical dk_run ! Douglas-Kroll logical dmd_run ! Dyall modified Dirac logical zora_run ! ZORA + logical x2c_run ! exact decoupling (X2C) integer mpoption c logical status @@ -56,6 +58,11 @@ c ZORA if (.not. rtdb_put(rtdb, 'zora', mt_log, 1, zora_run)) & call errquit('rel_input: rtdb_put failed', 0, RTDB_ERR) c +c X2C + x2c_run = .false. + if (.not. rtdb_put(rtdb, 'x2c', mt_log, 1, x2c_run)) + & call errquit('rel_input: rtdb_put failed', 0, RTDB_ERR) +c c Set some relativistic variables we could need later on c 1 if (.not. inp_read()) call errquit('rel_input: inp_read failed',0, @@ -75,7 +82,7 @@ c endif write(luout,10) clight 10 format(/,'The speed of light used in the relativistic ', - $ 'calculations is ',F16.10, 'au.'/) + $ 'calculations is ',E15.7, 'au.'/) c elseif (inp_compare(.false.,'douglas-kroll', test)) then dk_run = .true. @@ -88,6 +95,12 @@ c if (.not. rtdb_put(rtdb, 'dyall_mod_dir', mt_log, 1, dmd_run)) $ call errquit('rel_input: rtdb_put failed', 0, RTDB_ERR) call dmd_input(rtdb) +c + elseif (inp_compare(.false.,'x2c', test)) then + x2c_run = .true. + if (.not. rtdb_put(rtdb, 'x2c', mt_log, 1, x2c_run)) + & call errquit('rel_input: rtdb_put failed', 0, RTDB_ERR) + call x2c_input(rtdb) c elseif (inp_compare(.false.,'zora', test)) then call zora_input(rtdb) @@ -107,6 +120,11 @@ c if(.not. inp_f(zoracutoff)) zoracutoff = 1.0d-15 ! set a default cutoff if (.not. rtdb_put(rtdb,'zora:cutoff',mt_dbl,1,zoracutoff)) & call errquit('rel_input: rtdb put failed',0, RTDB_ERR) +c + elseif(inp_compare(.false.,'x2c:cutoff',test)) then + if(.not. inp_f(x2ccutoff)) x2ccutoff = 1.0d-15 ! set a default cutoff + if (.not. rtdb_put(rtdb,'x2c:cutoff',mt_dbl,1,x2ccutoff)) + & call errquit('rel_input: rtdb put failed',0, RTDB_ERR) c c zoracutoff_EFG, used in get_rhoS() from dft_zora_utils.F elseif(inp_compare(.false.,'zora:cutoff_EFG',test)) then diff --git a/src/NWints/rel/x2c.fh b/src/NWints/rel/x2c.fh new file mode 100644 index 0000000000..25f3f3562c --- /dev/null +++ b/src/NWints/rel/x2c.fh @@ -0,0 +1,15 @@ +c exact decoupling (X2C) related variables + + logical do_x2c, scale_x2c_hartree, scale_x2c_so_hartree + common/x2c_flags/ + & do_x2c, + & scale_x2c_hartree, + & scale_x2c_so_hartree + +c scaling for Hartree + double precision x2chscale, x2csoscale + common/x2c_params/x2chscale, x2csoscale +c cutoff + double precision x2ccutoff + common/x2c_tols/x2ccutoff + diff --git a/src/NWints/rel/x2c_input.F b/src/NWints/rel/x2c_input.F new file mode 100644 index 0000000000..9fcc92a264 --- /dev/null +++ b/src/NWints/rel/x2c_input.F @@ -0,0 +1,91 @@ +c Handles the X2C input + + subroutine x2c_input(rtdb) + + implicit none +#include "rtdb.fh" +#include "context.fh" +#include "global.fh" +#include "mafdecls.fh" +#include "inp.fh" +#include "stdio.fh" +#include "rel_consts.fh" +#include "util.fh" +#include "errquit.fh" +#include "x2c.fh" +c +c +c Read input for calculations with X2C (exact decoupling) +c +c All input is of the form: +c +c + integer rtdb ! [input] handle to database +c + character*255 test + double precision rtmp +c +c Preliminaries + do_x2c = .false. + + scale_x2c_hartree = .false. + scale_x2c_so_hartree = .false. + x2chscale=1.0d0 ! scaling for Hartree potential + x2csoscale=1.0d0 ! scaling in the SO operator +c +c Read input data beyond x2c; store in rtdb. + 10 if (inp_a(test)) then + if (inp_compare(.false.,'on',test)) then + do_x2c = .true. + else if (inp_compare(.false.,'off',test)) then + do_x2c = .false. +c +c process other x2c options +c +c Hartree scaling? + else if (inp_compare(.false.,'scalehartree',test)) then + scale_x2c_hartree = .true. + rtmp = 1.0d0 + if (.not.inp_f(rtmp)) then + write (luout,*) 'rtmp = ',rtmp + call errquit('x2c: error reading Hartree scaling factor', + & 1, INPUT_ERR) + else + x2chscale = rtmp + end if + +c Hartree scaling for SO only? + else if (inp_compare(.false.,'scalesoee',test)) then + scale_x2c_so_hartree = .true. + rtmp = 1.0d0 + if (.not.inp_f(rtmp)) then + write (luout,*) 'rtmp = ',rtmp + call errquit('x2c: error reading SOee scaling factor', + & 1, INPUT_ERR) + else + x2csoscale = rtmp + end if + +c +c keyword not recognized + else + call errquit('x2c_input: unknown directive',0, UNKNOWN_ERR) + endif + goto 10 + endif +c +c Put x2c parameters in rtdb + + if (.not. rtdb_put(rtdb, 'x2c:on', mt_log, 1,do_x2c)) + & call errquit('x2c_input: rtdb_put failed', 0, RTDB_ERR) +c + if (scale_x2c_hartree) then + write (luout,*) 'X2C: scaling for Hartree term =', x2chscale + end if + if (scale_x2c_so_hartree) then + write (luout,*) 'X2C: scaling for SO Hartree term =', + & x2csoscale + end if +c + return + end diff --git a/src/nwdft/GNUmakefile b/src/nwdft/GNUmakefile index a25aed8185..a8f16be556 100644 --- a/src/nwdft/GNUmakefile +++ b/src/nwdft/GNUmakefile @@ -7,7 +7,7 @@ LIB_DEFINES = - SUBDIRS = include input_dft scf_dft scf_dft_cg so_dft coulomb xc util grid dftgrad lr_tddft lr_tddft_grad zora spec rt_tddft libxc + SUBDIRS = include input_dft scf_dft scf_dft_cg so_dft coulomb xc util grid dftgrad lr_tddft lr_tddft_grad zora spec rt_tddft libxc x2c LIB_INCLUDES = -I./include -I./grid HEADERS = ../ddscf/cosmo.fh diff --git a/src/nwdft/scf_dft/dft_fockbld.F b/src/nwdft/scf_dft/dft_fockbld.F index 227263a2ee..41721a69b7 100644 --- a/src/nwdft/scf_dft/dft_fockbld.F +++ b/src/nwdft/scf_dft/dft_fockbld.F @@ -9,8 +9,8 @@ , i_degen,g_rho_exact,g_tmp_exact, g_addit_exact, , n_levels, act_levels, oprint_time, cc AJL/Begin/FDE -c , g_zora_sf,g_frozemb) - , g_zora_sf,g_frozemb,g_vxc_fde,g_xcinv_fde,g_dens_fde,eelec ) +c , g_rel_sf,g_frozemb) + , g_rel_sf,g_frozemb,g_vxc_fde,g_xcinv_fde,g_dens_fde,eelec ) cc AJL/End c c $Id$ @@ -26,6 +26,7 @@ c #include "dftps.fh" #include "cosmo.fh" #include "zora.fh" +#include "x2c.fh" #include "case.fh" c#include "dimqm.fh" c @@ -65,8 +66,8 @@ c c double precision Ebq c - integer g_zora_sf(*) ! spin-free zora ga - double precision Ezora_sf ! spin-free zora energy + integer g_rel_sf(*) ! spin-free zora/x2c ga + double precision Erel_sf ! spin-free zora/x2c energy c integer g_frozemb ! frozen embedding ga double precision Efrozemb ! energy @@ -446,22 +447,22 @@ c == Calculate the HF exchange (exact Coulomb), DFT exchange-correlation == c if (odftps) call pstat_off(ps_xc) c -c add zora contributions - if (do_zora) then - Ezora_sf =0.d0 +c add relativistic energy contributions + if (do_zora .or. do_x2c) then + Erel_sf =0.d0 if (ipol.gt.1) then - Ezora_sf = ga_ddot(g_dens(1),g_zora_sf(1)) - & + ga_ddot(g_dens(2),g_zora_sf(2)) + Erel_sf = ga_ddot(g_dens(1),g_rel_sf(1)) + & + ga_ddot(g_dens(2),g_rel_sf(2)) else - Ezora_sf = ga_ddot(g_dens(1),g_zora_sf(1)) + Erel_sf = ga_ddot(g_dens(1),g_rel_sf(1)) end if - Ecore = Ecore + Ezora_sf + Ecore = Ecore + Erel_sf c - call ga_dadd(1.d0,g_vxc(1),1.d0,g_zora_sf(1),g_vxc(1)) + call ga_dadd(1.d0,g_vxc(1),1.d0,g_rel_sf(1),g_vxc(1)) if (ipol.gt.1) - & call ga_dadd(1.d0,g_vxc(2),1.d0,g_zora_sf(2),g_vxc(2)) + & call ga_dadd(1.d0,g_vxc(2),1.d0,g_rel_sf(2),g_vxc(2)) c - end if ! do_zora + end if ! do_zora .or. do_x2c c c == if frozen embedding == Efrozemb = 0.d0 diff --git a/src/nwdft/scf_dft/dft_main0d.F b/src/nwdft/scf_dft/dft_main0d.F index 6c18a11a34..1c3ebfce53 100644 --- a/src/nwdft/scf_dft/dft_main0d.F +++ b/src/nwdft/scf_dft/dft_main0d.F @@ -34,6 +34,7 @@ c c #include "zora.fh" #include "rel_consts.fh" +#include "x2c.fh" #include "case.fh" c integer ga_create_atom_blocked @@ -212,6 +213,17 @@ c == Get the grid cutoff or set default == if(.not.rtdb_get(rtdb,'zora:not_zora_scale', ! FA & mt_log,1,not_zora_scale)) ! FA & not_zora_scale = .false. ! FA + +c ... jochen: +c == X2C options == + do_x2c = .false. + if (rtdb_get(rtdb,'x2c:on',mt_log,1,do_x2c)) + & do_x2c = .true. +c we use the variable zoracutoff also for the x2c option + if(.not.rtdb_get(rtdb,'x2c:cutoff',mt_dbl,1,zoracutoff)) + & zoracutoff = 1.0d-08 +c + c c == Get the light speed and other constants, if specified == call rel_init_con(rtdb) diff --git a/src/nwdft/scf_dft/dft_scf.F b/src/nwdft/scf_dft/dft_scf.F index 96677a79cd..7fb6dbe84e 100644 --- a/src/nwdft/scf_dft/dft_scf.F +++ b/src/nwdft/scf_dft/dft_scf.F @@ -40,6 +40,7 @@ c #include "dftps.fh" #include "cosmo.fh" #include "zora.fh" +#include "x2c.fh" #include "modelpotential.fh" cold#include "dimqm.fh" c @@ -225,11 +226,17 @@ cc AJL/End c gotsmear(ss)=abs(ss).gt.1d-9 c +c ... exact decoupling and other relativistic Hamiltonians + integer g_rel(2), g_x2c_u(2), g_x2c_u2c, g_x2c_c2u + logical lx2c_efg, lx2c_moment, lx2c_hfc, lx2c_keepU + logical lx2c_c2u, lx2c_u2c, lx2c_noatm, ltemp +c c misc c logical debug_fon logical do_zora_recalc, zora_recalc external zora_recalc + integer dbg c c MN solvation models --> c @@ -282,6 +289,8 @@ c c <-- MN solvation models c c ========================================================================= +c + dbg=1 ! debug level during code development. c k_3cERI = 0 k_3cwhat = 0 @@ -317,6 +326,58 @@ c me = ga_nodeid() nproc = ga_nnodes() + +c --------------------------------------------------------- +c check which relativistic Hamiltonian (if any) we're using +c and write some information to the output. +c comment: Niri's zora implementation added an array g_zora_sf +c to the Fock matrix in dft_fockbld. This array contains +c T(rel) - T(nrel). The nonrelativistic kinetic energy is always +c added to the Fock matrix in dft_fockbld. +c I changed the array name for g_zora_sf to g_rel and use +c it now for both methods. +c --------------------------------------------------------- + + if(me.eq.0 .and. dbg>0) + & write(luout,*) 'do_x2c =',do_x2c + +c make sure we don't use zora, x2c, or another +c two-component relativistic method at the same time + + if (do_zora .and. do_x2c) then + call errquit ('dft_scf: zora and x2c options conflict', + & 666, INPUT_ERR) + end if + +c write output about the relativistic treatment + + if (do_zora) then + if (me.eq.0) write (luout,*) 'dft: using ZORA' + end if + if (do_x2c) then + if (me.eq.0) write (luout,*) 'dft: using X2C' + end if + +c check for additional x2c keywords and set +c lx2c_keepU to T if we need it for any of the properties: + + lx2c_keepU = .false. + lx2c_efg = .false. + if (rtdb_get(rtdb, 'x2c:efg', mt_log, 1, + & lx2c_efg)) lx2c_keepU = .true. + lx2c_hfc = .false. + if (rtdb_get(rtdb, 'x2c:hfc', mt_log, 1, + & lx2c_hfc)) lx2c_keepU = .true. + lx2c_moment = .false. + if (rtdb_get(rtdb, 'x2c:moment', mt_log, 1, + & lx2c_moment)) lx2c_keepU = .true. + lx2c_noatm = .false. + if (rtdb_get(rtdb, 'x2c:noatm', mt_log, 1, + & lx2c_noatm)) continue + + if (lx2c_efg .and. me.eq.0) write (luout,*) + & 'x2c: will calculate EFGs, too' + c c !!! BGJ c Store SCF hamiltonian type as DFT for use in BGJ routines @@ -651,6 +712,27 @@ c c == force sleazy SCF into "direct" mode == call fock_force_direct(rtdb) c +c ------------------------------------------- +c calculate superposition of atomic densities +c if ZORA or X2C functionality is requested +c ------------------------------------------- + + if ((do_zora .or. do_x2c) .and. .not.lx2c_noatm) then + call ga_zero(g_dens_at(1)) + if (ipol.gt.1) call ga_zero(g_dens_at(2)) + call guess_dens(rtdb, geom, ao_bas_han, g_dens_at) + if (oskel) call ga_symmetrize(g_dens_at(1)) + if(ipol.gt.1) then + call ga_copy(g_dens_at(1),g_dens_at(2)) + call ga_dscal(g_dens_at(1),dble(ntotel-nclosed)/(ntotel)) + call ga_dscal(g_dens_at(2),dble(nclosed)/(ntotel)) + if(oskel) call ga_symmetrize(g_dens_at(2)) + end if + else if (do_x2c .and. lx2c_noatm) then + call ga_zero(g_dens_at(1)) + if (ipol.gt.1) call ga_zero(g_dens_at(2)) + end if ! do_zora .or. do_x2c +c c == get atomic zora contributions == if (.not.rtdb_get(rtdb,'zora',mt_log,1,do_zora)) do_zora = .false. c @@ -665,13 +747,13 @@ c == get filename for the zora data == call util_file_name('zora_sf',.false.,.false.,zorafilename) c c == zora arrays == - if(.not.ga_duplicate(g_vxc(1),g_zora_sf(1),'sf 1')) + if(.not.ga_duplicate(g_vxc(1),g_rel(1),'sf 1')) & call errquit('dft_scf: ga_duplicate failed',1, GA_ERR) - call ga_zero(g_zora_sf(1)) + call ga_zero(g_rel(1)) if(ipol.gt.1) then - if(.not.ga_duplicate(g_vxc(2),g_zora_sf(2),'sf 2')) + if(.not.ga_duplicate(g_vxc(2),g_rel(2),'sf 2')) & call errquit('dft_scf: ga_duplicate failed',1, GA_ERR) - call ga_zero(g_zora_sf(2)) + call ga_zero(g_rel(2)) endif c c == zora energy scaling arrays == @@ -691,18 +773,6 @@ c == create g_zora_Kinetic array == call ga_zero(g_zora_Kinetic(i)) enddo c -c == generate an superposition of atomic densities == - call ga_zero(g_dens_at(1)) - if (ipol.gt.1) call ga_zero(g_dens_at(2)) - call guess_dens(rtdb, geom, ao_bas_han, g_dens_at) - if (oskel) call ga_symmetrize(g_dens_at(1)) - if(ipol.gt.1) then - call ga_copy(g_dens_at(1),g_dens_at(2)) - call ga_dscal(g_dens_at(1),dble(ntotel-nclosed)/(ntotel)) - call ga_dscal(g_dens_at(2),dble(nclosed)/(ntotel)) - if(oskel) call ga_symmetrize(g_dens_at(2)) - end if -c c == in case fon is used together with zora == c pstrace is queried in the grid code == if (fon) then @@ -715,7 +785,7 @@ c c == try reading the zora atomic corrections from file == icalczora = 0 ! initialize the flag if (.not.dft_zora_read(zorafilename, nbf_ao, ipol, nmo, - & mult, g_zora_sf, g_zora_scale_sf)) icalczora = 1 + & mult, g_rel, g_zora_scale_sf)) icalczora = 1 c c check if zora corrections have to recalculated do_zora_recalc = zora_recalc(rtdb) @@ -772,7 +842,7 @@ c------- FA-code-added-09-26-11 --------------------------- END c c == write out the atomic zora corrections to file == if (.not.dft_zora_write(rtdb, ao_bas_han, zorafilename, - & nbf_ao, ipol, nmo, mult, g_zora_sf, g_zora_scale_sf)) + & nbf_ao, ipol, nmo, mult, g_rel, g_zora_scale_sf)) & call errquit('dft_scf: dft_zora_write failed', 0, DISK_ERR) end if ! icalczora c @@ -780,10 +850,52 @@ c == NOTE.-Storing g_zora_Kinetic to be used in rohf_fock.F == c == for cphf routine - FA-11-08-10 == c == -> g_zora_Kinetic is defined in zora.fh == do i=1,ipol - call ga_copy(g_zora_sf(i),g_zora_Kinetic(i)) + call ga_copy(g_rel(i),g_zora_Kinetic(i)) enddo end if ! do_zora c +c ------------------------------------------------- +c set up an exact decoupling Hamiltonian (optional) +c ------------------------------------------------- + + if (do_x2c) then + if (me.eq.0) write (luout,*) 'allocating g_x2c',nbf_ao + + if(.not.ga_duplicate(g_vxc(1),g_rel(1),'x2c 1')) + & call errquit('dft_scf: ga_duplicate failed',666, GA_ERR) + call ga_zero(g_rel(1)) + + if (me.eq.0) write (luout,*) 'calling calc_x2c_1e_scalar' + +c note: g_vxc is used as temp array in the numerical +c integration routines. +c g_x2c_u2c is created in the x2c routine and survives +c if keepU=.T. Same for the transformation matrices g_xc_u(:). +c optionally, g_x2c_c2u is also allocated and kept. + + call calc_x2c_1e_scalar_ga(rtdb, lx2c_keepU, + & lx2c_u2c, lx2c_c2u, + & nexc, g_dens_at, g_vxc, g_rel(1), g_x2c_u, + & g_x2c_u2c, g_x2c_c2u, toll_s) + +c debug: print the X2C U matrices + + if(me.eq.0 .and. dbg>1) then + write (luout,*) 'x2c U-L' + call ga_print(g_x2c_u(1)) + write (luout,*) 'x2c U-S' + call ga_print(g_x2c_u(2)) + end if ! debug + + if (ipol.gt.1) then + if(.not.ga_duplicate(g_vxc(2),g_rel(2),'x2c 2')) + & call errquit('dft_scf: ga_duplicate failed',1, GA_ERR) + call ga_copy(g_rel(1),g_rel(2)) + end if + + + end if ! do_x2c +c c == determine guess == if(.not.rtdb_get(rtdb,'forceatguess',mt_log,1,forceatguess)) . forceatguess=.false. @@ -1227,8 +1339,8 @@ c remove flipping to avoid multiple operation in geom opt. , i_degen,g_rho_exact,g_tmp_exact, g_addit_exact, , n_levels, act_levels, oprint_time, cc AJL/Begin/FDE -c & g_zora_sf,g_frozemb) - & g_zora_sf,g_frozemb,g_vxc_fde,g_xcinv_fde,g_dens_fde,eelec) +c & g_rel,g_frozemb) + & g_rel,g_frozemb,g_vxc_fde,g_xcinv_fde,g_dens_fde,eelec) cc AJL/End if(util_print('dft timings', print_high)) & time2=util_wallsec() ! end fock matrix build time @@ -1889,6 +2001,25 @@ c AOR begin endif c AOR end +c ... jochen: calculate x2c properties if so requested: + if (do_x2c) then + if (lx2c_efg) then +c x2c EFG + if (me.eq.0 .and. dbg>0) + & write (luout,*) 'calling calc_x2c_efg' + call calc_x2c_efg_scalar(rtdb, + & nexc, g_dens, g_dens_at, g_x2c_u) + end if + + if (lx2c_moment) then +c x2c dipole moment + if (me.eq.0 .and. dbg>0) + & write (luout,*) 'calling x2c_moment' + call calc_x2c_moment_scalar(rtdb, + & nexc, g_dens, g_dens_at, g_x2c_u, 'dipole', 3) + end if + end if ! do_x2c + c vdw bit c c activate disp if is present in rtdb @@ -2498,18 +2629,42 @@ cdft...Deallocate cdft arrays c c Deallocate zora related arrays if (do_zora) then - if (.not. ga_destroy(g_zora_sf(1))) call errquit( + if (.not. ga_destroy(g_rel(1))) call errquit( & 'dft_scf: ga_destroy failed ',0, GA_ERR) if (.not. ga_destroy(g_zora_scale_sf(1))) call errquit( & 'dft_scf: ga_destroy failed ',0, GA_ERR) if(ipol.gt.1) then - if (.not. ga_destroy(g_zora_sf(2))) call errquit( + if (.not. ga_destroy(g_rel(2))) call errquit( & 'dft_scf: ga_destroy failed ',0, GA_ERR) if (.not. ga_destroy(g_zora_scale_sf(2))) call errquit( & 'dft_scf: ga_destroy failed ',0, GA_ERR) end if end if - +c +c deallocate x2c arrays if necessary + if (do_x2c) then + if (.not. ga_destroy(g_rel(1))) call errquit( + & 'dft_scf: ga_destroy failed g_rel',0, GA_ERR) + if (ipol.gt.1) then + if (.not. ga_destroy(g_rel(1))) call errquit( + & 'dft_scf: ga_destroy failed g_rel',0, GA_ERR) + end if + if (lx2c_keepU) then + if(.not.ga_destroy(g_x2c_u(1))) call errquit( + & 'dft_scf: ga_destroy failed x2c_u(1)',1, GA_ERR) + if(.not.ga_destroy(g_x2c_u(2))) call errquit( + & 'dft_scf: ga_destroy failed x2c_u(2)',2, GA_ERR) + if (lx2c_u2c) then + if(.not.ga_destroy(g_x2c_u2c)) call errquit( + & 'dft_scf: ga_destroy failed x2c_u2c',51, GA_ERR) + end if + if (lx2c_c2u) then + if(.not.ga_destroy(g_x2c_c2u)) call errquit( + & 'dft_scf: ga_destroy failed x2c_c2u',54, GA_ERR) + end if + end if + end if ! do_x2c +c c AOR begin c deallocate xdm arrays if (lxdm.eq.1) then diff --git a/src/nwdft/x2c/GNUmakefile b/src/nwdft/x2c/GNUmakefile new file mode 100644 index 0000000000..117ccde70a --- /dev/null +++ b/src/nwdft/x2c/GNUmakefile @@ -0,0 +1,27 @@ +# +# + + OBJ = calc_x2c_w_scalar.o \ + x2c_getw_scalar.o \ + x2c_getw_efg_scalar.o \ + x2c_getw_moment_scalar.o \ + calc_x2c_1e_scalar_ga.o \ + calc_x2c_efg_scalar.o \ + calc_x2c_moment_scalar.o \ + calc_x2c_wefg_scalar.o \ + calc_x2c_wmoment_scalar.o \ + write_x2c_pc_dip.o \ + read_x2c_pc_dip.o + + + LIBRARY = libnwdft.a + +# LIB_DEFINES = -DNWCHEMX2C + LIB_DEFINES = + + LIB_INCLUDES = -I../include -I../../ddscf -I../grid + + USES_BLAS = + +include ../../config/makefile.h +include ../../config/makelib.h diff --git a/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F b/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F new file mode 100644 index 0000000000..80d3f6f07d --- /dev/null +++ b/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F @@ -0,0 +1,969 @@ + subroutine calc_x2c_1e_scalar_ga (rtdb, keepU, needu2c, needc2u, + & nexc, g_dens, g_vxc, g_x2c, g_u, g_u2c, g_c2u, toll_s) + +c ----------------------------------------------------------------- +c Purpose: calculate scalar X2C one-electron Hamiltonian matrix + +c Integrals are supposed to be initialized by the calling +c routine + +c Driver (c) 2012, 2015, 2022 J. Autschbach, jochena@buffalo.edu +c 'relham' code used for the original (2012) implementation +c (c) 2012 Daoling Peng. This code is now obsolete in NWChem. +c Contracted basis extension: J. Autschbach, 2015 +c New code using GA exclusively (c) 2022 J. Autschbach + +c Code is not yet (2022) well tested. Expect bugs & email me at the +c address shown above if you find one. Please provide a minimal +c working example (in-,output) for your bug report, if possible. + +c The relevant equations implemented here can be found in the +c following works, among others: + +c Autschbach, Peng, Reiher, J. Chem. Theory Comput. 2012, 8, +c 4239–4248. (initial NWChem implementation, field gradient calcs.) + +c Liu & Peng, J. Chem. Phys. 2009, 131, 031104. (X2C formalism in +c non-orthogonal basis) + +c Peng & Reiher, Theor. Chem. Acc. 2012, 131, 1081. (comparison of +c X2C approaches) + +c Autschbach, J., Quantum Theory for Chemical Applications, Oxford +c University Press (2021), Chapter 24. (further details re. the +c formalism) + +c The workflow for mapping onto an uncontracted basis and back is +c similar to int_1edk_ga.F. We have the problem here that anything +c that is calculated by numerical integration needs to be done in +c the contracted basis, because of the way the grid routines are +c written. I.e. unlike in int_1edk_ga.F we also need a +c back-transformation. For the time being, we use a naive +c left-inverse for this. Eventually, the numerical integrations +c will be replaced completely. +c ----------------------------------------------------------------- + + implicit none + +#include "mafdecls.fh" +#include "rtdb.fh" +#include "apiP.fh" +#include "global.fh" +#include "tcgmsg.fh" +#include "bas.fh" +#include "util.fh" +#include "stdio.fh" +#include "errquit.fh" +#include "dftpara.fh" +#include "cdft.fh" +#include "rel_consts.fh" +#include "cint1cache.fh" +#include "numerical_constants.fh" + +c subroutine arguments: + + integer rtdb ! [inp] runtime database GA handle + logical keepU ! [inp] keep U-matrix? + integer nexc ! [inp] no. of XC terms + integer g_dens(2) ! [inp] atom densities for model pot. + integer g_vxc(4) ! scratch + integer g_x2c ! [out] exact decoupling 1e operator + integer g_u(2) ! [out] decoupling transformation + integer g_u2c ! [out] basis trafo + integer g_c2u ! [out] basis trafo + logical needu2c ! [out] u2c trafo needed? + logical needc2u ! [out] c2u trafo needed? + double precision toll_s ! [inp] Smat diag. tolerance + +c GA handles used for temp storage in this routine: + integer g_t, g_s, g_w, g_v, g_temp, g_tmpv, g_X + integer g_smix, g_densu + integer g_tm12, g_sm12, g_h, g_m + +c local MA handles + + integer l_eval, k_eval + integer l_scr, k_scr + +c other local variables: + + integer ubas, cbas + integer nu, nu2, nunu, nc + integer me, type, i, j, ntemp + double precision sum, energy, rtemp + double precision c_2c, c_2c2, c_4c2 + + double precision ga_trace_diag + external ga_trace_diag + + integer info + integer ga_cholesky,ga_llt_i + external ga_cholesky,ga_llt_i + + double precision tol2e + logical master, analytic_pvp, modelpot_2e, use_ga, oskel_sav + integer dbg + double precision jfac(1),kfac(1) + + character*32 pname + +c ================================================================= + +c dbg = 1: debug numbers and flow. 2: debug also matrices +c dbg = 0: no debug output + dbg=1 + me=ga_nodeid() + master = me.eq.0 + pname = "calc_x2c_1e_scalar" + + if (dbg>0.and.master) write(luout,*) 'entering '//pname + + call ga_sync() + call ga_zero(g_x2c) + + tol2e=10.d0**(-itol2e) + +c src/NWints/dk/int_1edk_ga.F uses similar transformations as used +c here. There, oskel is deliberately set to .false., so I'm guessing +c we should do the same here but I'm not sure yet + + oskel_sav = oskel + oskel = .false. + + +c temporarily add alpha and beta model densities: +c TO BE REPLACED WITH 4-COMPONENT MODEL DENSITIES + + if (ipol.gt.1) + & call ga_dadd(1.d0, g_dens(1), 1.d0, g_dens(2), g_dens(1)) + +c --------------- +c initializations +c --------------- + + ubas = x2c_bas ! uncontracted basis + cbas = ao_bas_han ! contracted basis + +c make sure the input GAs have the correct dimension + + call ga_inquire(g_x2c,type,nc,nc) + if (nc.ne.nbf_ao) then + call errquit('x2c1e: g_x2c has wrong dimension',nc,GA_ERR) + end if + + if (.not. bas_numbf(cbas,ntemp)) + & call errquit('x2c1e: bas_ao error',ntemp, BASIS_ERR) + if (ntemp.ne.nc) + & call errquit('x2c1e: nc.ne.ntemp',ntemp, BASIS_ERR) + if (.not. bas_numbf(ubas,nu)) + & call errquit('x2c1e: nu error',nu, BASIS_ERR) + + if (master.and.dbg>0) write (luout,*) + & 'x2c: nu, nc =',nu,nc + + if (nu.lt.nc) call errquit( + & 'x2c uncontracted basis smaller than contracted', 1, + & RTDB_ERR) + + needu2c = (nu.gt.nc) + if (master) then + if (needu2c) then + write (luout,*) + & 'x2c INFO: the operator will be calculated in an' + write (luout,*) + & ' uncontracted auxiliary basis' + else + write (luout,*) + & 'x2c INFO: Assuming that the AO basis is fully uncontracted' + end if + end if + +c no of elements in the AO matrices and dimension of mDE: + + nunu = nu * nu + nu2 = 2* nu + +c --------------------------- +c read some options from rtdb +c --------------------------- + +c analytic pVp integrals are default, but it can be disabled + + analytic_pvp = .true. + if (.not. rtdb_get(rtdb, 'x2c:analyticpvp', + & mt_log, 1, analytic_pvp)) continue + +c model potential for 2e terms? + + modelpot_2e = .false. + if (.not. rtdb_get(rtdb, 'x2c:modelpot2e', + & mt_log, 1, modelpot_2e)) continue + +c if analyticpvp is .F. or if we need the model potential, +c we also need a contracted-to-uncontracted basis transformation +c unless the two bases are identical + + needc2u = ((.not.analytic_pvp .or. modelpot_2e).and.needu2c) + if (master.and.needc2u) write (luout,*) + & 'x2c INFO: x2c options require constructing the c2u trafo' + +c check rtdb switch to see whether we should perform decoupling +c in GA, or call relham routines with MA arrays + + use_ga = .false. + if (.not.rtdb_get(rtdb, 'x2c:usega', mt_log, 1, + & use_ga)) continue + if (master.and.use_ga) write(luout,*) + & 'x2c: will perform decoupling in GA mode' + +c ----------------------------------------- +c allocate GAs for T, V, S, and for W = pVp +c ----------------------------------------- + +c create S matrix GA. Do we need to use that atom-block stuff +c here, like they do in the SCF calling routine dft_main0d.F ??? + + if (.not. ga_create(MT_DBL,nu,nc,'g_s',1,1,g_s)) call + & errquit(pname//': ga_create failed g_s',11,GA_ERR) + call ga_zero(g_s) + +c the matrices for T, V, W are created as duplicates of g_s: + + if (.not.ga_duplicate(g_s, g_t,'g_t')) call + & errquit(pname//': ga_create failed g_t',12,GA_ERR) + call ga_zero(g_t) + + if (.not.ga_duplicate(g_s,g_v, 'g_v')) call + & errquit(pname//': ga_create failed g_v',13,GA_ERR) + call ga_zero(g_v) + + if (.not.ga_duplicate(g_s, g_w, 'g_w')) call + & errquit(pname//': ga_create failed g_w',14,GA_ERR) + call ga_zero(g_w) + +c --------------------------------------- +c Analytic one-electron matrices: S, T, V +c --------------------------------------- + + if (ocache) call int_1e_uncache_ga() + call int_1e_ga(ubas, ubas ,g_s, 'overlap' ,oskel) + call int_1e_ga(ubas, ubas, g_t, 'kinetic' , oskel) + call int_1e_ga(ubas, ubas, g_v, 'potential', oskel) + +c symmetrize, just in case ... + call ga_symmetrize(g_s) + call ga_symmetrize(g_t) + call ga_symmetrize(g_v) + + call ga_sync() + + if (master.and.dbg>0) write(luout,*) 'x2c: T,V,S done' + +c ------------------------------------------------------ +c later we need a transformation from the contracted (c) +c to the uncontracted (u) basis, and vice versa for the +c density matrix sooner. the sequence comes +c from routine int_1edk_ga +c ------------------------------------------------------ + +c u2c transforms the basis from uncontracted to contracted +c (really, these are just the contraction coefficients, +c but this is how it is done in the DKH routines) + + if (needu2c) then + + if (.not. ga_create(MT_DBL,nu,nc,'u2c',1,1,g_u2c)) + & call errquit(pname//': create u2c failed',51,GA_ERR) + call ga_zero(g_u2c) + + if (.not. ga_create(MT_DBL,nu,nc,'smix',1,1,g_smix)) + & call errquit(pname//': create mixed overlap failed',52,GA_ERR) + call ga_zero(g_smix) + + if (.not. ga_create(MT_DBL,nu,nu,'temp',1,1,g_temp)) + & call errquit(pname//': error creating temp',53,GA_ERR) + + if (master.and.dbg>0) write(luout,*) 'x2c: u2c mem done' + + call int_1e_ga(ubas, cbas, g_smix, 'overlap' ,oskel) + call ga_copy(g_s,g_temp) + call ga_matpow(g_temp, -1.0d0, 1d-12) + call ga_dgemm('n','n',nu,nc,nu,1.0d0, + & g_temp, g_smix, 0.0d0, g_u2c) + + if (.not. ga_destroy(g_temp)) + & call errquit('x2c1e: error destroy temp',53, GA_ERR) + + if (.not. ga_destroy(g_smix)) + & call errquit('x2c1e: error destroy smix',52, GA_ERR) + + if (master.and.dbg>0) write(luout,*) 'x2c: u2c done' + + end if ! needu2c + +c c2u transforms the basis from contracted to uncontracted. +c we have to do this as a generalized left-inverse of u2c. +c Use [(A^T A)**(-1) A^T] A = 1 to define the left-inverse. + + if (needc2u) then + + if (.not. ga_create(MT_DBL,nc,nu,'c2u',1,1,g_c2u)) + & call errquit(pname//': create c2u failed',54,GA_ERR) + call ga_zero(g_c2u) + + if (.not. ga_create(MT_DBL,nc,nc,'temp',1,1,g_temp)) + & call errquit(pname//': failed creating temp',55,GA_ERR) + + if (master.and.dbg>0) write(luout,*) 'x2c: c2u mem done' + + call ga_dgemm('t','n',nc,nc,nu,1.0d0,g_u2c,g_u2c, + & 0.0d0,g_temp) + + call ga_matpow(g_temp, -1.0d0, 1d-12) + if (master.and.dbg>0) write(luout,*) 'x2c: c2u matpow done' + + call ga_dgemm('n','t',nc,nu,nc,1.0d0,g_temp,g_u2c, + & 0.0d0,g_c2u) + + if (.not. ga_destroy(g_temp)) + & call errquit('x2c1e: error destroy temp',55, GA_ERR) + + if (master.and.dbg>0) write(luout,*) 'x2c: c2u done' + +c check c2u * u2c + + if (.not. ga_create(MT_DBL,nc,nc,'temp',1,1,g_temp)) + & call errquit(pname//': error creating temp',56,GA_ERR) + + call ga_dgemm('n','n',nc,nc,nu,1.0d0,g_c2u,g_u2c, + & 0.0d0,g_temp) + + if (dbg>1) then + call ga_print(g_u2c) + call ga_print(g_c2u) + call ga_print(g_temp) + end if + +c check the quality of the left-inverse. the product +c c2u*u2c must be a unit matrix of dimension nc + + sum = ga_trace_diag(g_temp) + if (master) write (luout,'(1x,a,1x,e15.7)') + & 'x2c c2u*u2c: ',sum + + if (abs(sum-real(nc)).gt.1.0d-10) then + if (master) write (luout,*) + & 'x2c WARNING: left-inverse in basis trafo is inaccurate' + end if + + if (.not. ga_destroy(g_temp)) + & call errquit('x2c1e: error destroy temp',56, GA_ERR) + + if (master.and.dbg>0) write(luout,*) 'x2c: c2u done' + + end if ! needc2u + + if (needu2c) then + +c transform density matrix to the uncontracted basis: +c c2u is how the basis would transform in this case. +c the density matrix is based on the MO coefficients, +c P = C n C^T, with C being a collections of MO vectors +c in the c-basis. We do a passive transformation, +c since the MOs are to remain the same. In this case, +c the transformation of the MO vectors is contra- +c gredient to the basis and we need u2c: +c P(u) = u2c P(c) u2c^T. + + if (.not. ga_create(MT_DBL,nc,nu,'temp',1,1,g_temp)) + & call errquit(pname//': error creating temp',57,GA_ERR) + + if (.not. ga_create(MT_DBL,nu,nu,'densu',1,1,g_densu)) + & call errquit(pname//': error creating densu',58,GA_ERR) + + if (master.and.dbg>0) write(luout,*) 'x2c: dens c2u start' + + call ga_zero(g_densu) + call ga_dgemm('n','t',nc,nu,nc, 1.0d0, + & g_dens(1),g_u2c,0.0d0,g_temp) + if (master.and.dbg>0) write(luout,*) 'x2c: dens c2u step1' + call ga_dgemm('n','n',nu,nu,nc ,1.0d0, + & g_u2c, g_temp, 0.0d0,g_densu) + call ga_symmetrize(g_densu) + + if (.not. ga_destroy(g_temp)) + & call errquit(pname//': error destroy temp',57, GA_ERR) + + if (master.and.dbg>0) write(luout,*) 'x2c: dens c2u done' + + else + +c if there is no need for the u2c trafo, we +c just assign the GA handle of g_dens(1) to g_densu + + g_densu = g_dens(1) + + end if ! needu2c + + if (master.and.dbg>0) write (luout,*) + & 'g_densu, g_dens(1) = ',g_densu,g_dens(1) + +c ------------------------------------ +c use sum of atomic densities to check +c that the AO matrices are OK +c ------------------------------------ + + energy = 0d0 + + if (.not. ga_create(MT_DBL,nu,nu,'g_temp',1,1,g_temp)) call + & errquit(pname//': ga_create g_temp failed',59,GA_ERR) + call ga_zero(g_temp) + + if (master.and.dbg>0) write(luout,*) 'x2c: debug S:' + + call ga_dgemm('n','n',nu,nu,nu, 1.0d0, + & g_densu,g_s,0.0d0,g_temp) + + sum = ga_trace_diag(g_temp) + + if (master) write (luout,'(1x,a,1x,e15.7)') + & 'calc_x2c: tr(P * S) : ',sum + + if (master.and.dbg>0) write(luout,*) 'x2c: debug T:' + + call ga_dgemm('n','n',nu,nu,nu, 1.0d0, + & g_densu,g_t,0.0d0,g_temp) + + sum = ga_trace_diag(g_temp) + + if (master) write (luout,'(1x,a,1x,e15.7)') + & 'calc_x2c: tr(P * T) : ',sum + energy = energy + sum + + if (master.and.dbg>0) write(luout,*) 'x2c: debug V:' + + call ga_dgemm('n','n',nu,nu,nu, 1.0d0, + & g_densu,g_v,0.0d0,g_temp) + + sum = ga_trace_diag(g_temp) + + if (master) write (luout,'(1x,a,1x,e15.7)') + & 'calc_x2c: tr(P * V) : ',sum + energy = energy + sum + + if (.not. ga_destroy(g_temp)) call errquit + & (pname//': temp ga corrupt?',59, GA_ERR) + + if (master) write (luout,'(1x,a,1x,e15.7)') + & 'calc_x2c: 1e energy : ',energy + +c ---------------------------------------------------------- +c as this routine gets embedded in the scalar DFT framework, +c we make it work similar to ZORA. I.e., for compatibility +c we need to SUBTRACT the nonrel H from the operator. +c this is done here, upfront. +c ---------------------------------------------------------- + +c if needu2c is .T., we now need to allocate an array for the +c x2c operator in the uncontracted basis => g_X +c otherwise, we simply use the GA handle of g_x2c. + + if (needu2c) then + if (.not.ga_duplicate(g_s, g_X, 'g_X')) call + & errquit(pname//': ga_create failed g_X',61,GA_ERR) + call ga_zero(g_X) + else + g_X = g_x2c + end if ! needu2c + + call ga_dadd(1.d0, g_X, -1.0d0, g_t, g_X) + call ga_dadd(1.d0, g_X, -1.0d0, g_v, g_X) + +c ------------------------------------------------------ +c In the case of using a model Coulomb potential in the +c transformation (V and W integrals), we need to +c subtract the corresponding Coulomb potential from the +c one-electron operator and add it to V (and later in W) +c ------------------------------------------------------ + + if (modelpot_2e) then + + if(.not.ga_create(mt_dbl,nu,nu,'tmpv',0,0,g_tmpv)) + & call errquit(pname//': error creating ga',141, GA_ERR) + + jfac(1) = 1.0d0 + kfac(1) = 0.0d0 + + call ga_zero(g_tmpv) + + if (master.and.dbg>0) write (luout,*) + & 'x2c_1e: calling fock2e for model potential' + + call fock_2e(geom, ubas, 1, jfac, kfac, + & tol2e, oskel, g_densu, g_tmpv, .false.) + + call ga_sync() + +c subtract from the 1e Hamiltonian: + call ga_add(1.0d0, g_X, -1.0d0, g_tmpv, g_X) + +c add Coul. pot. to g_v: + call ga_add(1.0d0, g_v, 1.0d0, g_tmpv, g_v) + + if (.not. ga_destroy(g_tmpv)) call errquit + & (pname//': ga corrupt?',141, GA_ERR) + + end if ! modelpot_2e + +c g_densu not needed past this point + if (needu2c) then + if (.not. ga_destroy(g_densu)) + & call errquit(pname//': error destroy densu',58, GA_ERR) + else + if (g_densu.ne.g_dens(1)) call errquit( + & pname//': g_densu inconsistency 1',g_densu, UNKNOWN_ERR) + end if + + + call ga_zero(g_w) + +c --------------------------------------------------------------- +c nuclear potential only: calculate analytic pV dot p integrals +c and add them to the array g_w(:). +c the calls to the integral routines below have been adapted +c from the douglas-kroll code in nwchem. +c --------------------------------------------------------------- + + if (analytic_pvp) then + if (master) write (luout,*) + & 'x2c: calculating analytic p.Vp integrals' + +c add scalar part p.Vp to g_w: + call int_1e_ga(ubas, ubas ,g_w, 'pvp' ,oskel) + call ga_symmetrize(g_w) + end if ! analytic_pvp + +c -------------------------------------------------- +c if needed: calculate all or part of +c (sig.p)V(sig.p) integrals by numerical integration, +c similar to how the ZORA spin-orbit arrays are done. +c We have the option to skip the nuclear part, if those +c integrals are done analytically +c -------------------------------------------------- + + if (analytic_pvp .and. .not.modelpot_2e) then + if (master) write(luout,*)'x2c: skipping numerical W integrals' + else + + if (master) write(luout,*) 'x2c: calculating W numerically' + if (modelpot_2e .and. master) + & write(luout,*) ' (2e model pot. only)' + + + if (needu2c) then + +c here we need to use the contracted basis ... +c use g_tmpv to hold the array. +c g_vxc has the right dimension already + if (dbg>0.and.master) write (luout,*) 'g_w numint c2u start' + if(.not.ga_create(mt_dbl,nc,nc,'tmpw',0,0,g_tmpv)) + & call errquit(pname//': error creating tmpw',147, GA_ERR) + call ga_zero(g_tmpv) + call x2c_getw_scalar(rtdb, g_dens(1), g_tmpv, g_vxc, nexc, + & analytic_pvp, .not.modelpot_2e) + if (dbg>0.and.master) write (luout,*) 'g_w numint c2u end' +c transform to ubas: tmpv = c2u^T g_tmpv c2u, add to g_w + + if(.not.ga_create(mt_dbl,nc,nu,'temp',0,0,g_temp)) + & call errquit('x2c1e: error creating temp',148, GA_ERR) + call ga_zero(g_temp) + call ga_dgemm('n','n',nc,nu,nc, 1.0d0, + & g_tmpv,g_c2u,0.0d0,g_temp) + if (master.and.dbg>0) write(luout,*) 'x2c: g_w c2u step1' + call ga_dgemm('t','n',nu,nu,nc ,1.0d0, + & g_c2u, g_temp, 1.0d0,g_w) + if (master.and.dbg>0) write(luout,*) 'x2c: g_w c2u step2' + if (.not. ga_destroy(g_tmpv)) call errquit + & (pname//': ga corrupt?',147, GA_ERR) + if (.not. ga_destroy(g_temp)) call errquit + & (pname//': ga corrupt?',148, GA_ERR) + else +c cbas = ubas. Just continue as usual + if (dbg>0.and.master) write (luout,*) 'g_w numint start' + call x2c_getw_scalar(rtdb, g_dens(1), g_w, g_vxc, nexc, + & analytic_pvp, .not.modelpot_2e) + if (dbg>0.and.master) write (luout,*) 'g_w numint end' + end if ! needu2c + + end if ! need analytic integration + +c W is the pVp matrix, incl model pot if requested: + if (dbg>1) call ga_print(g_w) + +c sanity checks: + + if (.not.needu2c) then + if (g_X.ne.g_x2c) call errquit( + & 'x2c1e: g_X/g_x2c inconsistency 1',g_X-g_x2c, UNKNOWN_ERR) + end if + +c ----------------------------------------------- +c Input data are all in place for decoupling step +c ----------------------------------------------- + +c define some constants related to speed of light: +c (define them here directly as inverses, which we need later) + + c_2c = 1.0d0/(cau*2.d0) ! 1/2c + c_2c2 = 1.0d0/(cau*cau*2.d0) ! 1/2c**2 + c_4c2 = 1.0d0/(cau*cau*4.d0) ! 1/4c**2 + +c scale W by 1/(4c^2) + + call ga_scale(g_w, c_4c2) + +c assemble the 'scalar 4-component' mDE Hamiltonian + + if (.not. ga_create(MT_DBL,nu2,nu2,'x2c_h',1,1,g_h)) + & call errquit(pname//': ga_create failed g_h',66, GA_ERR) + call ga_zero(g_h) + + call ga_copy_patch('n', ! L-L block = V + & g_v, 1, nu, 1, nu, + & g_h, 1, nu, 1, nu) + + call ga_copy_patch('n', ! L-S block = T + & g_t, 1, nu, 1, nu, + & g_h, 1, nu, nu+1, nu2) + + call ga_copy_patch('n', ! S-L block = T + & g_t, 1, nu, 1, nu, + & g_h, nu+1, nu2, 1, nu) + + call ga_add_patch( ! S-S block = W/(4c**2)-T + & 1.0d0, g_w, 1, nu, 1, nu, + & -1.0d0, g_t, 1, nu, 1, nu, + & g_h, nu+1, nu2, nu+1, nu2) + +c assemble the metric for the mDE: + + if (.not. ga_create(MT_DBL,nu2,nu2,'x2c_m',1,1,g_m)) + & call errquit(pname//': ga_create failed g_m',67, GA_ERR) + + call ga_zero(g_m) + + call ga_copy_patch('n', ! L-L block = S + & g_s, 1, nu, 1, nu, + & g_m, 1, nu, 1, nu) + +c call ga_scale(g_t, c_2c2) + call ga_copy_patch('n', ! S-S block = T/(2c**2) + & g_t, 1, nu, 1, nu, + & g_m, nu+1, nu2, nu+1, nu2) + call ga_scale_patch( + & g_m, nu+1, nu2, nu+1, nu2, c_2c2) + +c diagonalize the mDE Hamiltonian: + + if (.not. ma_push_get(mt_dbl, nu2, 'eval', l_eval, k_eval)) + & call errquit(pname//': failed allocation eval', nu2, + & MA_ERR) + + if (.not.ga_duplicate(g_h, g_temp,'g_temp')) call + & errquit(pname//': ga_dup failed g_temp',68,GA_ERR) + call ga_zero(g_temp) + + if (dbg>1) call ga_print(g_h) + if (dbg>1) call ga_print(g_m) + +#if defined(PARALLEL_DIAG) +#ifdef SCALAPACK +c +c SCALAPACK piece needs code similar to what's +c in src/NWints/dk/int_1edk_ga.F + if (master .and. dbg>0) write (luout,*) + & 'calling ga_pdsygv replacement sequence of routines' +c call ga_pdsygv(g_h, g_m, g_temp, dbl_mb(k_eval)) + info= ga_cholesky('L', g_m) + info = ga_llt_i('L', g_m, -1) + info = ga_cholesky('L', g_m, -1) + + call ga_dgemm('t','n',nu2, nu2, nu2, 1.0d0, + & g_m, g_h, 0.0d0, g_temp) + + call ga_dgemm('n','n', nu2, nu2, nu2, 1.0d0, + & g_temp, g_m, 0.0d0, g_h) + + call ga_pdsyev(g_h, g_temp, dbl_mb(k_eval), 0) + + call ga_dgemm('n','n', nu2, nu2, nu2, 1.0d0, + & g_m, g_temp, 0.0d0, g_h) + call ga_copy (g_h, g_temp) + +#else + if (master .and. dbg>0) write (luout,*) 'calling ga_diag' + call ga_diag(g_h, g_m, g_temp, dbl_mb(k_eval)) +#endif +#else + if (master .and. dbg>0) write (luout,*) 'calling ga_diag_seq' + call ga_diag_seq(g_h, g_m, g_temp, dbl_mb(k_eval)) +#endif + +c we don't need the mDE eigenvalues further + + if (.not.ma_chop_stack(l_eval)) call + & errquit(pname//': ma_chop_stack failed k_eval',l_eval,MA_ERR) + if (dbg>1) call ga_print(g_temp) + +c destroy arrays for mDE Hamiltonian and metric, +c allocate the same handles again for scratch space + + if (.not. ga_destroy(g_h)) + & call errquit(pname//': ga_destroy failed g_h',66, GA_ERR) + + if (.not. ga_destroy(g_m)) + & call errquit(pname//': ga_destroy failed g_m',67, GA_ERR) + + if (.not.ga_duplicate(g_s, g_h, 'g_h (temp)')) call + & errquit(pname//': ga_dup failed g_h(temp)',71,GA_ERR) + + if (.not.ga_duplicate(g_s, g_m, 'g_m (temp)')) call + & errquit(pname//': ga_dup failed g_m(temp)',72,GA_ERR) + +c set up and perform the decoupling. + + call ga_copy_patch('n', + & g_temp, 1, nu, nu+1, nu2, + & g_m, 1, nu, 1, nu) ! g_m now holds array A + + call ga_copy_patch('n', + & g_temp, nu+1, nu2, nu+1, nu2, + & g_h, 1, nu, 1, nu) ! g_h now holds array B + + if (dbg>1) call ga_print(g_m) + if (dbg>1) call ga_print(g_h) + +c destroy temp GA and reallocate with nubas**2 elements + + if (.not. ga_destroy(g_temp)) + & call errquit(pname//': ga_destroy failed temp',68, GA_ERR) + + if (.not.ga_duplicate(g_s, g_temp,'g_temp')) call + & errquit(pname//': ga_dup failed g_temp',73,GA_ERR) + +c solve matrix equation X A = B for X, store in g_h +c that is, solve A' X' = B' (' = Transpose), then transpose + call ga_transpose(g_m, g_temp) + call ga_copy(g_temp, g_m) + call ga_transpose(g_h, g_temp) + call ga_copy(g_temp, g_h) ! keep copy of B' in g_temp, too + info = ga_solve(g_m, g_h) ! g_h now has solution X + call ga_dgemm('N', 'N', nu, nu, nu, 1.d0, + & g_m, g_h, -1.d0, g_temp) ! g_temp = A'X'-B', should be zero + call ga_maxelt(g_temp, rtemp) + if (master) write(luout,*) + & 'largest element in A''X''-B'': ',rtemp + call ga_transpose(g_h, g_temp) + call ga_copy(g_temp, g_h) + + + if (dbg>1) call ga_print(g_h) + +c assemble S + X(+)TX/(2c**2) in g_s +c assemble X(+)T + TX - X(+)TX + V in g_t + + call ga_dgemm('N', 'N', nu, nu, nu, 1.d0, + & g_t, g_h, 0.d0, g_temp) + + call ga_dgemm('T', 'N', nu, nu, nu, 1.d0, + & g_h, g_t, 0.d0, g_m) + + call ga_copy(g_m, g_t) + + call ga_add(1.0d0, g_t, 1.0d0, g_temp, g_t) + + call ga_dgemm('T', 'N', nu, nu, nu, 1.d0, + & g_h, g_temp, 0.d0, g_m) + + call ga_add (1.0d0, g_t, -1.0d0, g_m, g_t) + if (dbg>1) call ga_print(g_t) + + call ga_add (1.0d0, g_t, 1.0d0, g_v, g_t) + + call ga_copy(g_s, g_temp) ! save a copy of S in g_temp + + call ga_scale(g_m, c_2c2) + + call ga_add (1.0d0, g_s, 1.0d0, g_m, g_s) + + if (dbg>1) then + if (master) write (luout,*) 'tilde S = S + X''TX/(2c^2):' + call ga_print(g_s) + if (master) write (luout,*) 'X''T + TX - X''TX + V:' + call ga_print(g_t) + end if + +c now assemble the metric correction for the FW Hamiltonian +c g_m, g_v can be used for scratch +c g_temp still holds S +c g_h still holds X + + call ga_copy (g_temp, g_v) + call ga_matpow(g_v, -FP_Half, 1d-12) + + call ga_dgemm('T', 'N', nu, nu, nu, 1.d0, + & g_v, g_s, 0.d0, g_m) + call ga_dgemm('N', 'N', nu, nu, nu, 1.d0, + & g_m, g_v, 0.d0, g_s) + + call ga_matpow(g_s, -FP_Half, 1d-12) + + call ga_dgemm('N', 'N', nu, nu, nu, 1.d0, + & g_v, g_s, 0.d0, g_m) + + call ga_matpow(g_temp, FP_Half, 1d-12) + + call ga_dgemm('N', 'N', nu, nu, nu, 1.d0, + & g_m, g_temp, 0.d0, g_s) ! g_s = = UL + + call ga_dgemm('N', 'N', nu, nu, nu, 1.d0, + & g_h, g_s, 0.d0, g_m) ! g_m = US g_h, g_v, g_temp now free + +c construct the FW Hamiltonian in g_h. +c we then need to ADD it to g_X since it might +c contain -V(coul) already. +c also, the g_X array already has T+V subtracted +c such that it ties in with the zora code + + call ga_dgemm('T', 'N', nu, nu, nu, 1.d0, + & g_s, g_t, 0.d0, g_temp) + call ga_dgemm('N', 'N', nu, nu, nu, 1.d0, + & g_temp, g_s, 0.d0, g_h) + + call ga_dgemm('T', 'N', nu, nu, nu, 1.d0, + & g_m, g_w, 0.d0, g_temp) + call ga_dgemm('N', 'N', nu, nu, nu, 1.d0, + & g_temp, g_m, 1.d0, g_h) + + if (dbg>1) call ga_print(g_h) + + call ga_add(1.0d0, g_h, 1.0d0, g_X, g_X) + +c free up some memory: + + if (.not. ga_destroy(g_temp)) + & call errquit(pname//': ga_destroy failed temp',73, GA_ERR) + + if (.not. ga_destroy(g_h)) + & call errquit(pname//': ga_destroy failed g_h',71, GA_ERR) + + if (.not. ga_destroy(g_t)) + & call errquit(pname//': ga_destroy failed t',12, GA_ERR) + + if (.not. ga_destroy(g_v)) + & call errquit(pname//': ga_destroy failed v',13, GA_ERR) + + if (.not. ga_destroy(g_w)) + & call errquit(pname//': ga_destroy failed w',14, GA_ERR) + + +c ----------------------------------------------------- +c save decoupling transformation, if requested by input +c this is kept in the uncontracted basis. +c if we don't keep the transformation we also don't +c need to keep the u2c [or c2u] transformation +c ----------------------------------------------------- + + if (keepU) then + if (.not. ga_create(MT_DBL,nu,nu,'x2c_UL',1,1,g_u(1))) + & call errquit(pname//': ga_create failed UL',75, GA_ERR) + if (.not. ga_create(MT_DBL,nu,nu,'x2c_US',1,1,g_u(2))) + & call errquit(pname//': ga_create failed US',76, GA_ERR) + + call ga_copy(g_s, g_u(1)) + call ga_copy(g_m, g_u(2)) + call ga_scale(g_u(2), c_2c) + end if ! keepU + + if (.not. ga_destroy(g_s)) + & call errquit(pname//': ga_destroy failed s',11, GA_ERR) + + if (.not. ga_destroy(g_m)) + & call errquit(pname//': ga_destroy failed m',72, GA_ERR) + + if (dbg>1) call ga_print(g_X) + +c sanity check: + + if (.not.needu2c) then + if (g_X.ne.g_x2c) call errquit( + & pname//': g_X/g_x2c inconsistency 2',g_X-g_x2c, UNKNOWN_ERR) + end if + +c ---------------------------------------------- +c transform x2c operator to contracted basis and +c store in g_x2c. Otherwise, we are already done +c ---------------------------------------------- + + if (needu2c) then + if (dbg>0.and.master) write(luout,*) 'x2c: u2c trafo of result' + if (.not. ga_create(MT_DBL,nc,nu,'temp',1,1,g_temp)) + & call errquit('x2c1e: ga_create failed temp',77, + & GA_ERR) + if (g_X.eq.g_x2c) call errquit( + & pname//': g_X/g_x2c inconsistency 3',g_X-g_x2c, UNKNOWN_ERR) + + call ga_dgemm('t','n',nc,nu,nu,1.0d0, + & g_u2c,g_X,0.0d0,g_temp) +c note: if needu2c.eq..T. then g_x2c and g_X are not the +c same. Hence, g_x2c is over-written here + call ga_dgemm('n','n',nc,nc,nu,1.0d0, + & g_temp,g_u2c, 0.0d0,g_x2c) + + if (.not. ga_destroy(g_temp)) + & call errquit('x2c1e: ga_destroy failed temp',77,GA_ERR) + end if ! needu2c + + call ga_symmetrize(g_x2c) + +c de-allocate g_X, if needed, and related arrays + + if (needu2c) then + if (.not. ga_destroy(g_X)) + & call errquit('x2c1e: ga_destroy failed g_X',61,GA_ERR) + + if (.not.keepU) then + if (.not. ga_destroy(g_u2c)) call errquit + & (pname//': ga_destroy failed u2c',51,GA_ERR) + end if + end if ! needu2c + if (needc2u .and. .not.keepU) then + if (.not. ga_destroy(g_c2u)) call errquit + & (pname//': ga_destroy failed c2u',54,GA_ERR) + end if ! needc2u + +c restore model alpha and beta densities: + + if (ipol.gt.1) + & call ga_dadd(1.d0, g_dens(1), -1.d0, g_dens(2), g_dens(1)) + + +c -------- +c all done +c -------- + + call ga_sync() + + if (dbg>1) then + call ga_print(g_x2c) + end if + + oskel = oskel_sav ! restore oskel value + + if (dbg>0.and.master) write(luout,*) 'leaving x2c_1e_scalar' + +c ================================================================= + + return + end + diff --git a/src/nwdft/x2c/calc_x2c_efg_scalar.F b/src/nwdft/x2c/calc_x2c_efg_scalar.F new file mode 100644 index 0000000000..a08ab57bc6 --- /dev/null +++ b/src/nwdft/x2c/calc_x2c_efg_scalar.F @@ -0,0 +1,712 @@ + subroutine calc_x2c_efg_scalar (rtdb, nexc, + & g_dscf, g_dens_at, g_u) + +c ----------------------------------------------------------------- +c purpose: calculate one-electron property EFG using the +c two-component exact-decoupling Hamiltonian + +c For the time being we MUST use an uncontracted basis ! + +c Integrals are supposed to be initialized by the calling +c routine. + +c Driver (c) 2012 J. Autschbach, SUNY, jochena@buffalo.edu +c X2C 'relham' code (c) 2012 Daoling Peng + +c Approach: The transformation matrices g_u come from calc_x2c_1e +c if certain options are set. +c +c ----------------------------------------------------------------- + + implicit none + +#include "mafdecls.fh" +#include "rtdb.fh" +#include "apiP.fh" +#include "global.fh" +#include "tcgmsg.fh" +#include "bas.fh" +#include "util.fh" +#include "stdio.fh" +#include "errquit.fh" +#include "dftpara.fh" +#include "cdft.fh" +#include "geom.fh" +c#include "rel_consts.fh" +#include "cosmo.fh" + +c subroutine arguments: + + integer rtdb ! [in] runtime database GA handle + integer nexc ! [in] no. of XC terms + integer g_dscf(2) ! [in] density matrix from SCF + integer g_dens_at(2) ! [in] atom densities for model pot. + integer g_u(2) ! [in] decoupling matrices + +c local variables: + + integer basis + integer nbas, nbas2 + integer me, type, i, j + double precision sum + character*2 symbol + character*16 element, at_tag + +c GA handles used for temp storage in this routine: + integer g_P(2), g_efgint, g_temp, g_efg, g_w(6) + +c dimensioning arrays + integer alo(3), ahi(3), blo(3), bhi(3), clo(3), chi(3) + +c MA handles for arrays passed to relop routine: + integer l_dmem , k_dmem + integer l_amP , k_amP + integer l_amQ , k_amQ + integer l_omP , k_omP + integer l_amUL , k_amUL + integer l_amUS , k_amUS + +c MA handles for the EFG matrices in the small component basis + integer l_w(6), k_w(6) + +c other MA handles + integer l_xyzpt, k_xyzpt, l_zanpt, k_zanpt + +c bq variables (MV) + logical dobq + integer bq_ncent + integer i_cbq + integer i_qbq + double precision elpotbq + + double precision ga_trace_diag + external ga_trace_diag + double precision tol2e, accval + logical master, analytic_pvp, status + integer dbg + + integer ndmem, ntemp + integer iat, nat + + double precision xp, yp, zp, xn, yn, zn, zan + double precision rr, rr5 + double precision efgel(6), efgnuc(6), etmp(6) + double precision origin(3) + + double precision pifac, pi, deg, third + parameter (third=1.0d0/3.0d0) +c parameter(froth=4.0d0/3.0d0) +c parameter(pifac=froth*3.14159265358979323846264338327950288419d0) + +c ================================================================= + +c --------------- +c initializations +c --------------- + +c options / settings + + dbg=0 + + me=ga_nodeid() + master = me.eq.0 + + if (dbg>0.and.master) write(luout,*) 'entering x2c_efg' + + call ga_sync() + +c constants: + + tol2e=10.d0**(-itol2e) + + call int_acc_get(accval) + + if (dbg>0.and.master) write(luout,*) 'accval = ',accval +c accval = 1d-25 +c call int_acc_set(accval) + + pi = acos(-1.0d0) + deg = 180.0d0/pi + pifac = (4.0d0/3.0d0)*pi + + basis = ao_bas_han ! AO basis handle + +c make sure the input GAs have the correct dimension + + call ga_inquire(g_u(1),type,nbas,nbas) + if (nbas.ne.nbf_ao) then + call errquit('x2c_efg: g_u has wrong dimension',nbas,GA_ERR) + end if + + if (master.and.dbg>0) write (luout,*) 'x2c: nbas =',nbas + nbas2 = nbas * nbas + +c in light of the recent updates of the x2c code, it is +c important to check that we are working with an uncontracted +c basis here. +c eventually, this will be fixed + + if (.not. bas_numbf(x2c_bas,ntemp)) + & call errquit('x2c_efg: ntemp error',ntemp, BASIS_ERR) + + if (ntemp.ne.nbas) + & call errquit( + & 'x2c_efg: cannot currently use a contracted basis', + & ntemp, BASIS_ERR) + +c ------------- +c Calculate EFG +c ------------- + +c initialize integrals that were not already initialized + +c call hnd_giao_init(basis,1) + +c ----- define points for calculation ----- +c 1. nuclei: for now, we take ALL nuclei +c + status=geom_ncent(geom,nat) +c + if (.not. ma_push_get(mt_dbl,3*nat,'xyz pnt',l_xyzpt,k_xyzpt)) + & call errquit('x2c_efg: ma failed',911,MA_ERR) + if (.not. ma_push_get(mt_dbl,nat,'zan pnt',l_zanpt,k_zanpt)) + & call errquit('x2c_efg: ma failed',911,MA_ERR) +c + do iat=1,nat + status=geom_cent_get(geom,iat,at_tag,dbl_mb(k_xyzpt+3*(iat-1)), + & dbl_mb(k_zanpt+iat-1)) + end do + + alo(1) = nbas + alo(2) = -1 + alo(3) = -1 + ahi(1) = nbas + ahi(2) = nbas + ahi(3) = 6*nat + if (.not.nga_create(MT_DBL,3,ahi,'g_efgint',alo,g_efgint)) call + & errquit('x2c_efg: nga_create failed g_efgint',11,GA_ERR) + call ga_zero(g_efgint) + +c calculate field gradient integrals (same as FC+SD in NMR ...) + call int_giao_1ega(basis,basis,g_efgint,'sd+fc', + & dbl_mb(k_xyzpt),nat, oskel) + +c comment: The electronic integrals contain the isotropic +c `contact' piece. However, when constructing the traceless +c EFG tensor, those contributions disappear. We might as well +c take them out explicitly + +c calculate FC integrals separately + ahi(3) = nat + if (.not.nga_create(MT_DBL,3,ahi,'temp',alo,g_temp)) call + & errquit('add_x2c: nga_create failed g_temp',31,GA_ERR) + call ga_zero(g_temp) + + call int_giao_1ega(basis,basis,g_temp,'fc', + & dbl_mb(k_xyzpt),nat,oskel) + +c +c Take out FC part from SD+FC (i.e. from xx, yy and zz components) +c + alo(1) = 1 + ahi(1) = nbas + alo(2) = 1 + ahi(2) = nbas + blo(1) = 1 + bhi(1) = nbas + blo(2) = 1 + bhi(2) = nbas + do iat = 1, nat + alo(3) = 1+(iat-1)*6 + ahi(3) = 1+(iat-1)*6 + blo(3) = iat + bhi(3) = iat + do i = 1, 3 ! runs over xx, yy, zz + call nga_add_patch(1.0d0,g_efgint,alo,ahi, + & pifac,g_temp,blo,bhi, + & g_efgint,alo,ahi) + alo(3) = alo(3)+1 + ahi(3) = ahi(3)+1 + enddo + enddo + + if (.not. ga_destroy(g_temp)) call errquit + & ('x2c_efg: temp ga corrupt?',31, GA_ERR) + +c the field gradient integrals carry a factor of 3 +c that we don't want: + + call ga_scale(g_efgint, third) + +c temporarily add alpha and beta density, we only need the +c sum here: !!! CAREFUL, +c TJHIS IS NOT CORRECT. SEE HFC ROUTINE + + if (ipol.gt.1) + & call ga_dadd(1.d0, g_dscf(1), 1.d0, g_dscf(2), g_dscf(1)) + + if (dbg>1 .and.master) write (luout,*) 'x2c_efg before iat loop' + +c --------------------------------------- +c calculate EFGs in a loop over the atoms +c --------------------------------------- + + do iat = 1,nat + + xp = dbl_mb(k_xyzpt +3*(iat-1)) + yp = dbl_mb(k_xyzpt+1+3*(iat-1)) + zp = dbl_mb(k_xyzpt+2+3*(iat-1)) + + if (dbg>1 .and.master) write (luout,*) 'x2c_efg: iat=',iat + +c -------------------- +c nuclear contribution +c -------------------- + + do i = 1,6 + efgnuc(i) = 0d0 + end do + + do i = 1,nat + xn = dbl_mb(k_xyzpt +3*(i-1)) - xp + yn = dbl_mb(k_xyzpt+1+3*(i-1)) - yp + zn = dbl_mb(k_xyzpt+2+3*(i-1)) - zp + zan = dbl_mb(k_zanpt+i-1) + rr = sqrt(xn*xn + yn*yn + zn*zn) + if (rr.ge.1.0d-3) then +c (skip if it is the same nucleus or nuclei too close) + rr5=rr*rr*rr*rr*rr + efgnuc(1) = efgnuc(1) - zan*xn*xn/rr5 + efgnuc(2) = efgnuc(2) - zan*yn*yn/rr5 + efgnuc(3) = efgnuc(3) - zan*zn*zn/rr5 + efgnuc(4) = efgnuc(4) - zan*xn*yn/rr5 + efgnuc(5) = efgnuc(5) - zan*xn*zn/rr5 + efgnuc(6) = efgnuc(6) - zan*yn*zn/rr5 + end if + end do ! i = loop over all other nuclei + +c create traceless version of nuclear contribution to EFG: + etmp(1) = 2.0d0*efgnuc(1) - efgnuc(2) - efgnuc(3) + etmp(2) = 2.0d0*efgnuc(2) - efgnuc(1) - efgnuc(3) + etmp(3) = 2.0d0*efgnuc(3) - efgnuc(1) - efgnuc(2) + etmp(4) = 3.0d0*efgnuc(4) + etmp(5) = 3.0d0*efgnuc(5) + etmp(6) = 3.0d0*efgnuc(6) + do i = 1,6 + efgnuc(i) = etmp(i) + end do + +c ----------------------- +c electronic contribution +c ----------------------- + +c First, we do the case without picture change corrections + +c copy electronic EFG integrals into temp array: +c we also rearrange them such that we get the traceless +c versions of the integrals right away + + alo(1) = nbas + alo(2) = -1 + alo(3) = -1 + ahi(1) = nbas + ahi(2) = nbas + ahi(3) = 6 + + if (.not.nga_create(MT_DBL,3,ahi,'efg',alo,g_efg)) call + & errquit('add_x2c: nga_create failed g_efg',32,GA_ERR) + call ga_zero(g_efg) + + ahi(3) = 1 + if (.not.nga_create(MT_DBL,2,ahi,'temp',alo,g_temp)) call + & errquit('add_x2c: nga_create failed g_temp',31,GA_ERR) + call ga_zero(g_temp) + + alo(1) = 1 + ahi(1) = nbas + alo(2) = 1 + ahi(2) = nbas + + blo(1) = 1 + bhi(1) = nbas + blo(2) = 1 + bhi(2) = nbas + + clo(1) = 1 + chi(1) = nbas + clo(2) = 1 + chi(2) = nbas + clo(3) = 1 + chi(3) = 1 + +c create traceless version of EFG matrices in g_efg +c for the selected reference point + +c step 1: accumulate 3xx, 3yy, 3zz, +c and accumulate xx+yy+zz in g_temp + do i = 1,3 + alo(3) = (iat-1)*6 + i + ahi(3) = alo(3) + blo(3) = i + bhi(3) = blo(3) + call nga_add_patch(3.0d0,g_efgint,alo,ahi, + & 1d0,g_efg,blo,bhi, + & g_efg,blo,bhi) + call nga_add_patch(1.0d0,g_efgint,alo,ahi, + & 1d0,g_temp,clo,chi, + & g_temp,clo,chi) + end do +c step 2: subtract xx+yy+zz from diagonal + do i = 1,3 + blo(3) = i + bhi(3) = blo(3) + call nga_add_patch(1.0d0,g_efg,blo,bhi, + & -1d0,g_temp,clo,chi, + & g_efg,blo,bhi) + end do + +c indices 1, 2, 3 of g_efg are now the components +c 3xx-rr, 3yy-rr, 3zz-rr + +c step 3: assign 3xy, 3xz, 3yz to the remaining elements 4, 5, 6 + do i = 4,6 + alo(3) = (iat-1)*6 + i + ahi(3) = alo(3) + blo(3) = i + bhi(3) = blo(3) + call nga_add_patch(3.0d0,g_efgint,alo,ahi, + & 1d0,g_efg,blo,bhi, + & g_efg,blo,bhi) + end do + +c calculate electronic EFG components: + + alo(3) = 1 ! for density matrix + ahi(3) = 1 + + do i = 1,6 ! loop over EFG components + + if (dbg>1 .and.master) write (luout,*) 'x2c_efg: i=',i + + efgel(i) = 0d0 + +c if we use array g_efg, use this: + blo(3) = i ! select this section from array g_efg + bhi(3) = blo(3) + +c if we use g_efgint, use the boundaries below: +c$$$ blo(3) = i + (iat-1)*6 +c$$$ bhi(3) = blo(3) + + +c tr[P*EFG] + alo(1) = 1 + ahi(1) = nbas + alo(2) = 1 + ahi(2) = nbas + call ga_zero(g_temp) + call nga_matmul_patch('n','n',1d0,0d0, + & g_dscf(1),alo,ahi, + & g_efg, blo,bhi, + & g_temp,clo,chi) + sum = ga_trace_diag(g_temp) + + efgel(i) = efgel(i) + sum + + end do ! i = terms in EFG + +c form the traceless EFG tensor elements +c 3x**2 - r**2, etc, for diagonal elements + +c$$$ etmp(1) = 2.0d0*efgel(1) - efgel(2) - efgel(3) +c$$$ etmp(2) = 2.0d0*efgel(2) - efgel(1) - efgel(3) +c$$$ etmp(3) = 2.0d0*efgel(3) - efgel(1) - efgel(2) +c$$$ etmp(4) = 3.0d0*efgel(4) +c$$$ etmp(5) = 3.0d0*efgel(5) +c$$$ etmp(6) = 3.0d0*efgel(6) +c$$$ +c$$$ do i = 1,6 +c$$$ efgel(i) = etmp(i) +c$$$ end do + +c print results: + + if (master) then + write (luout,*) + write (luout,*) 'X2C EFG: Before picture-change corr.' + write (luout,'(1x,a,i4,6e15.7)') 'x2cefg: inuc, efgnuc =', + & iat, (efgnuc(i), i=1,6) + write (luout,'(1x,a,i4,6e15.7)') 'x2cefg: inuc, efgel =', + & iat, (efgel(i), i = 1,6) + write (luout,'(1x,a,i4,6e15.7)') 'x2cefg: inuc, efgtot =', + & iat, (efgel(i)+efgnuc(i), i = 1,6) + write (luout,*) + end if + +c --------------------------------------------------- +c calculate picture-change corrected EFG operator +c for the selected reference point (nuclear position) +c --------------------------------------------------- + +c allocate arrays to hold the AO matrices of the EFG +c operator in the small-component basis +c (we'll calculate all 6 matrices in one go) + + alo(1) = nbas + alo(2) = -1 + alo(3) = -1 + ahi(1) = nbas + ahi(2) = nbas + ahi(3) = 1 + do j = 1,6 + if (.not.nga_create(MT_DBL,2,ahi,'g_w',alo,g_w(j))) + & call errquit( + & 'x2cefg: nga_create failed g_w',1+10*j,GA_ERR) + call ga_zero(g_w(j)) + end do + + origin(1) = xp + origin(2) = yp + origin(3) = zp + if (dbg>0.and.master) write (luout,*) 'calling getw' + call x2c_getw_efg_scalar( + & rtdb, g_dens_at, origin, + & g_w, + & nexc) + if (dbg>0.and.master) write (luout,*) 'return from getw' + +c ----------------------------------- +c Allocate relop arrays with MA +c ----------------------------------- + +c amP + if (.not. ma_push_get(mt_dbl, nbas2, + & 'amP', l_amP, k_amP)) + & call errquit('x2c1e: failed allocation amP', nbas2, + & MA_ERR) + +c amQ + if (.not. ma_push_get(mt_dbl, nbas2, + & 'amQ0', l_amQ, k_amQ)) + & call errquit('x2c1e: failed allocation amQ', nbas2, + & MA_ERR) + +c amUL + if (.not. ma_push_get(mt_dbl, nbas2, + & 'amUL', l_amUL, k_amUL)) + & call errquit('x2c1e: failed allocation amUL', nbas2, + & MA_ERR) + +c amUS + if (.not. ma_push_get(mt_dbl, nbas2, + & 'amUS', l_amUS, k_amUS)) + & call errquit('x2c1e: failed allocation omUS', nbas2, + & MA_ERR) + +c omP + if (.not. ma_push_get(mt_dbl, nbas2, + & 'omPr', l_omP, k_omP)) + & call errquit('x2c1e: failed allocation omP', nbas2, + & MA_ERR) + +c -------------------- +c allocate operator GA +c -------------------- + + if(.not.ga_create(mt_dbl, nbas, nbas,'g_P',0,0, + & g_P)) + & call errquit( + & 'x2c_efg: error creating g_P',666, GA_ERR) + +c copy decoupling transformation into MA + + call dfill(nbas2, 0.0d0, dbl_mb(k_amUL), 1) + call dfill(nbas2, 0.0d0, dbl_mb(k_amUS), 1) + call ga_get(g_u(1),1,nbas,1,nbas, dbl_mb(k_amUL),nbas) + call ga_get(g_u(2),1,nbas,1,nbas, dbl_mb(k_amUS),nbas) + +c ------------------------------------------------------------ +c in a loop over the EFG components, transform the +c operator to two-component form, and calculate the electronic +c EFG component again +c ------------------------------------------------------------ + + do i = 1,6 ! loop over EFG components + + call dfill(nbas2, 0.0d0, dbl_mb(k_amP), 1) + call dfill(nbas2, 0.0d0, dbl_mb(k_amQ), 1) + call dfill(nbas2, 0.0d0, dbl_mb(k_omP), 1) + +c extract EFG component from GA: + + alo(1) = 1 + ahi(1) = nbas + alo(2) = 1 + ahi(2) = nbas + alo(3) = i + ahi(3) = i + + blo(1) = nbas + blo(2) = 1 + + call nga_get(g_efg, alo, ahi, dbl_mb(k_amP), blo) + +c extract EFG operator in small-component basis from GA + + call ga_get(g_w(i),1,nbas,1,nbas,dbl_mb(k_amQ), nbas) + +c debug: + if (dbg>1 .and. i<4) then + if (master) then + write (luout,*) 'EFG matrix, nuc, comp',iat,i + call moutr(dbl_mb(k_amP),nbas,nbas,'R','EFG-mat') + write (luout,*) 'pEFGp matrix, nuc, comp',iat,i + call moutr(dbl_mb(k_amQ),nbas,nbas,'R','pEFGp-mat') + end if + end if + +c ------------------------------- +c allocate scratch memory, +c call the X2C relop routine +c ------------------------------- + + if (master) write(luout,*) 'calling RELOP routines' + + call mem_relop_1c(nbas, ndmem) + + if (master) write (luout,*) 'ndmem = ',ndmem +c dmem + if (.not. ma_push_get(mt_dbl, ndmem, + & 'dmem', l_dmem, k_dmem)) + & call errquit('x2cefg: failed allocation dmem', ndmem, + & MA_ERR) + + call dfill(nbas2, 0.0d0, dbl_mb(k_omP), 1) + + call relop_1c(nbas, + & dbl_mb(k_amP), + & dbl_mb(k_amQ), + & dbl_mb(k_amUL), + & dbl_mb(k_amUS), + & dbl_mb(k_omP), + & dbl_mb(k_dmem), ndmem) + +c delete dmem array + + if (.not.ma_pop_stack(l_dmem)) call + & errquit('x2c: ma_chop_stack failed k_dmem',l_dmem,MA_ERR) + + +c ----------------------------------------- +c Sort output MA arrays into Property Operator GA +c ----------------------------------------- + + call ga_zero(g_P) + call ga_put(g_P,1,nbas,1,nbas, dbl_mb(k_omP), nbas) + +c call ga_print(g_P) + +c ----------------------------------------- +c calculate electronic EFG again, this time +c using the transformed operator +c ----------------------------------------- + + efgel(i) = 0.0d0 + +c g_temp always uses the same dimensions clo, chi + clo(1) = 1 + chi(1) = nbas + clo(2) = 1 + chi(2) = nbas + + + alo(1) = 1 + ahi(1) = nbas + alo(2) = 1 + ahi(2) = nbas + blo(1) = 1 + bhi(1) = nbas + blo(2) = 1 + bhi(2) = nbas + +c tr[P*EFG] + call ga_zero(g_temp) + call nga_matmul_patch('n','n',1d0,0d0, + & g_dscf(1),alo,ahi, + & g_P,blo,bhi, + & g_temp,clo,chi) + sum = ga_trace_diag(g_temp) + efgel(i) = efgel(i) + sum + + end do ! i = loop over EFG components + +c print results: + + if (master) then + write (luout,*) + write (luout,*) 'X2C EFG: After picture-change corr.' + write (luout,'(1x,a,i4,6e15.7)') 'x2cefg: inuc, efgnuc =', + & iat, (efgnuc(i), i=1,6) + write (luout,'(1x,a,i4,6e15.7)') 'x2cefg: inuc, efgel =', + & iat, (efgel(i), i = 1,6) + write (luout,'(1x,a,i4,6e15.7)') 'x2cefg: inuc, efgtot =', + & iat, (efgel(i)+efgnuc(i), i = 1,6) + write (luout,*) + end if + +c -------------------- +c clean up some GA memory +c -------------------- + + if (.not. ga_destroy(g_efg)) call errquit + & ('x2cefg: ga corrupt?',32, GA_ERR) + if (.not. ga_destroy(g_temp)) call errquit + & ('x2cefg: ga corrupt?',31, GA_ERR) + + if (.not. ga_destroy(g_P)) call errquit + & ('x2cefg: ga P corrupt?',666, GA_ERR) + + do j = 1,6 + if (.not. ga_destroy(g_w(j))) call errquit + & ('x2cefg: failed destroying g_w',1+10*j, GA_ERR) + end do + + if (.not.ma_chop_stack(l_amP)) call errquit + & ('x2c_efg: ma_chop_stack l_amP failed',911,MA_ERR) + + +c -------------------------------------------------------- +c end loop over refernce points at which EFG is calculated +c (typically the list of nuclei) +c -------------------------------------------------------- + + end do ! iat, loop over nuclei + + if (.not. ga_destroy(g_efgint)) call errquit + & ('x2cefg: ga corrupt?',11, GA_ERR) + +c ------- Deallocate MA memory ------ +c + if (.not.ma_pop_stack(l_zanpt)) call errquit + & ('x2cefg, ma_pop_stack of l_zanpt failed',911,MA_ERR) + if (.not.ma_pop_stack(l_xyzpt)) call errquit + & ('x2cefg, ma_pop_stack of l_xyzpt failed',911,MA_ERR) + +c undo addition of alpha and beta density matrix: + + if (ipol.gt.1) + & call ga_dadd(1.d0, g_dscf(1), -1.d0, g_dscf(2), g_dscf(1)) + +c -------- +c all done +c -------- + + call ga_sync() + + if (dbg>0.and.master) write(luout,*) 'leaving x2c_efg' + +c ================================================================= + + return + end + diff --git a/src/nwdft/x2c/calc_x2c_moment_scalar.F b/src/nwdft/x2c/calc_x2c_moment_scalar.F new file mode 100644 index 0000000000..c5ee70cac6 --- /dev/null +++ b/src/nwdft/x2c/calc_x2c_moment_scalar.F @@ -0,0 +1,507 @@ + subroutine calc_x2c_moment_scalar (rtdb, nexc, + & g_dscf, g_dens_at, g_u, type, ncomp) + +c ----------------------------------------------------------------- +c purpose: calculate some multipole moments using the +c two-component exact-decoupling Hamiltonian + +c For the time being we MUST use an uncontracted basis ! + +c Integrals are supposed to be initialized by the calling +c routine. + +c Driver (c) 2012 J. Autschbach, SUNY, jochena@buffalo.edu +c X2C 'relham' code (c) 2012 Daoling Peng + +c Approach: The transformation matrices g_u come from calc_x2c_1e +c if certain options are set. +c +c ----------------------------------------------------------------- + + implicit none +c +#include "mafdecls.fh" +#include "rtdb.fh" +#include "apiP.fh" +#include "global.fh" +#include "tcgmsg.fh" +#include "bas.fh" +#include "util.fh" +#include "stdio.fh" +#include "errquit.fh" +#include "dftpara.fh" +#include "cdft.fh" +#include "geom.fh" +c#include "rel_consts.fh" +#include "cosmo.fh" +#include "msgids.fh" +#include "dra.fh" +#include "inp.fh" +c +c subroutine arguments: + + integer rtdb ! [in] runtime database GA handle + integer nexc ! [in] no. of XC terms + integer g_dscf(2) ! [in] density matrix from SCF + integer g_dens_at(2) ! [in] atom densities for model pot. + integer g_u(2) ! [in] decoupling matrices + integer ncomp ! [in] number of components for moment + character*(*) type ! type of moment + +c local variables: + + integer basis + integer nbas, nbas2 + integer me, idum, i, j + double precision sum + character*2 symbol + character*16 element, at_tag + +c GA handles used for temp storage in this routine: + integer g_P, g_int, g_temp, g_moment, g_w(ncomp) + +c dimensioning arrays + integer alo(3), ahi(3), blo(3), bhi(3), clo(3), chi(3) + +c MA handles for arrays passed to relop routine: + integer l_dmem , k_dmem + integer l_amP , k_amP + integer l_amQ , k_amQ + integer l_omP , k_omP + integer l_amUL , k_amUL + integer l_amUS , k_amUS + + double precision ga_trace_diag + external ga_trace_diag + double precision tol2e, accval + logical master, analytic_pvp, status + integer dbg + + integer ndmem, ntemp + + double precision moment(ncomp) + double precision origin(3) +c + integer i_comp + character*3 ch_comp + logical dosavepcdip + character*(nw_max_path_len) fn_pcdip +c + logical dmat_to_file + external dmat_to_file +c +c ================================================================= + +c --------------- +c initializations +c --------------- + +c options / settings + + dbg=1 + + me=ga_nodeid() + master = me.eq.0 + + if (dbg>0.and.master) write(luout,*) 'entering x2c_moment' + + call ga_sync() +c + dosavepcdip = .false. + if(.not.(rtdb_get(rtdb,'x2c:savepcdip',mt_log,1,dosavepcdip))) + & dosavepcdip = .false. + +c sanity check: type of integral, and dimensioning + + if (type.eq.'dipole') then + if (ncomp.ne.3) call errquit + & ('x2c_moment: ncomp has wrong value',666,INPUT_ERR) + if(master) write(luout,*) 'x2c: dipole moment calculation' + else + if (master) write(luout,*) + & 'x2c_moment: integral type not supported. Aborting' + return + end if + + tol2e=10.d0**(-itol2e) + + call int_acc_get(accval) + + if (dbg>0.and.master) write(luout,*) 'accval = ',accval +c accval = 1d-25 +c call int_acc_set(accval) + + +c check if we have the routines, otherwise return without +c doing anyhting: + +#ifdef NWCHEMX2C + continue +#else + if (master) write(luout,*) + & 'x2c_moment: NWCHEMX2C not defined. aborting' + return +#endif + + basis = ao_bas_han ! AO basis handle + +c make sure the input GAs have the correct dimension + + call ga_inquire(g_u(1),idum,nbas,nbas) + if (nbas.ne.nbf_ao) then + call errquit('x2c_moment: g_u has wrong dimension',nbas,GA_ERR) + end if + + if (master.and.dbg>0) write (luout,*) 'nbas =',nbas + nbas2 = nbas * nbas + +c in light of the recent updates of the x2c code, it is +c important to check that we are working with an uncontracted +c basis here. +c eventually, this will be fixed + + if (.not. bas_numbf(x2c_bas,ntemp)) + & call errquit('x2c_moment: ntemp error',ntemp, BASIS_ERR) + + if (ntemp.ne.nbas) + & call errquit( + & 'x2c_moment: cannot currently use a contracted basis', + & ntemp, BASIS_ERR) + +c temporarily add alpha and beta density, we only need the +c sum here: + + if (ipol.gt.1) + & call ga_dadd(1.d0, g_dscf(1), 1.d0, g_dscf(2), g_dscf(1)) + +c coordinate origin + + origin(1) = 0d0 + origin(2) = 0d0 + origin(3) = 0d0 + +c -------------------------- +c Calculate electric moments +c -------------------------- + +c initialize integrals that were not already initialized + +c call hnd_giao_init(basis,1) + +c allocate integral array and calculate AO matrix. +c the integral type in variable 'type' must match +c the available types and no. of components in +c routine int_mpole_1ega + + alo(1) = nbas + alo(2) = -1 + alo(3) = -1 + ahi(1) = nbas + ahi(2) = nbas + ahi(3) = ncomp + if (.not.nga_create(MT_DBL,3,ahi,'g_int',alo,g_int)) call + & errquit('x2c_moment: nga_create failed g_int',11,GA_ERR) + call ga_zero(g_int) + call int_mpole_1ega(basis,basis,g_int,type,origin, + & oskel) + + if(.not.ga_create(mt_dbl, nbas, nbas,'g_temp',0,0,g_temp)) + & call errquit( + & 'x2c_moment: error creating g_temp',12, GA_ERR) + +c First, we do the case without picture change corrections + + alo(1) = 1 + ahi(1) = nbas + alo(2) = 1 + ahi(2) = nbas + + blo(1) = 1 + bhi(1) = nbas + blo(2) = 1 + bhi(2) = nbas + + clo(1) = 1 + chi(1) = nbas + clo(2) = 1 + chi(2) = nbas + clo(3) = 1 + chi(3) = 1 + +c calculate electronic moment components: + + alo(3) = 1 ! for density matrix + ahi(3) = 1 + + do i = 1,ncomp ! loop over moment components + + moment(i) = 0.0d0 + +c + blo(3) = i ! select this section from array g_int + bhi(3) = blo(3) + +c tr[P*Moment] + moment(i) = 0.0d0 + + call ga_zero(g_temp) + call nga_matmul_patch('n','n',1d0,0d0, + & g_dscf(1),alo,ahi, + & g_int, blo,bhi, + & g_temp,clo,chi) + sum = ga_trace_diag(g_temp) + + moment(i) = moment(i) + sum + + end do ! i = terms in moment + +c print results: + + if (master) then + write (luout,*) + write (luout,*) 'X2C Moment: Before picture-change corr.' + write (luout,'(1x,a,50e15.7)') 'moment = ', + & (moment(i), i=1,ncomp) + write (luout,*) + end if + +c --------------------------------------------------- +c calculate picture-change corrected EFG operator +c for the selected reference point (nuclear position) +c --------------------------------------------------- + +c allocate arrays to hold the AO matrices of the EFG +c operator in the small-component basis +c (we'll calculate all matrices in one go) + + alo(1) = nbas + alo(2) = -1 + alo(3) = -1 + ahi(1) = nbas + ahi(2) = nbas + ahi(3) = 1 + do j = 1,ncomp + if (.not.nga_create(MT_DBL,2,ahi,'g_w',alo,g_w(j))) + & call errquit( + & 'x2cefg: nga_create failed g_w',1+10*j,GA_ERR) + call ga_zero(g_w(j)) + end do + + if (dbg>0.and.master) write (luout,*) 'calling getw' + call x2c_getw_moment_scalar( + & rtdb, g_dens_at, origin, + & g_w, + & nexc, type, ncomp) + if (dbg>0.and.master) write (luout,*) 'return from getw' + +c ----------------------------------- +c Allocate relop arrays with MA +c ----------------------------------- + +c amP + if (.not. ma_push_get(mt_dbl, nbas2, + & 'amP', l_amP, k_amP)) + & call errquit('x2c1e: failed allocation amP', nbas2, + & MA_ERR) + +c amQ + if (.not. ma_push_get(mt_dbl, nbas2, + & 'amQ0', l_amQ, k_amQ)) + & call errquit('x2c1e: failed allocation amQ', nbas2, + & MA_ERR) + +c amUL + if (.not. ma_push_get(mt_dbl, nbas2, + & 'amUL', l_amUL, k_amUL)) + & call errquit('x2c1e: failed allocation amUL', nbas2, + & MA_ERR) + +c amUS + if (.not. ma_push_get(mt_dbl, nbas2, + & 'amUS', l_amUS, k_amUS)) + & call errquit('x2c1e: failed allocation omUS', nbas2, + & MA_ERR) + +c omP + if (.not. ma_push_get(mt_dbl, nbas2, + & 'omPr', l_omP, k_omP)) + & call errquit('x2c1e: failed allocation omP', nbas2, + & MA_ERR) + +c -------------------- +c allocate operator GA +c -------------------- + + if(.not.ga_create(mt_dbl, nbas, nbas,'g_P',0,0, + & g_P)) + & call errquit( + & 'x2c_efg: error creating g_P',666, GA_ERR) + +c copy decoupling transformation into MA + + call dfill(nbas2, 0.0d0, dbl_mb(k_amUL), 1) + call dfill(nbas2, 0.0d0, dbl_mb(k_amUS), 1) + call ga_get(g_u(1),1,nbas,1,nbas, dbl_mb(k_amUL),nbas) + call ga_get(g_u(2),1,nbas,1,nbas, dbl_mb(k_amUS),nbas) + +c ------------------------------------------------------------ +c in a loop over the moment components, transform the +c operator to two-component form, and recalculate moment +c ------------------------------------------------------------ + + do i = 1,ncomp ! loop over components + + call dfill(nbas2, 0.0d0, dbl_mb(k_amP), 1) + call dfill(nbas2, 0.0d0, dbl_mb(k_amQ), 1) + call dfill(nbas2, 0.0d0, dbl_mb(k_omP), 1) + +c extract moment component from GA: + + alo(1) = 1 + ahi(1) = nbas + alo(2) = 1 + ahi(2) = nbas + alo(3) = i + ahi(3) = i + + blo(1) = nbas + blo(2) = 1 + + call nga_get(g_int, alo, ahi, dbl_mb(k_amP), blo) + +c extract operator in small-component basis from GA + + call ga_get(g_w(i),1,nbas,1,nbas,dbl_mb(k_amQ), nbas) + +c ------------------------------- +c allocate scratch memory, +c call the X2C relop routine +c ------------------------------- + + if (master) write(luout,*) 'calling RELOP routines' + + call mem_relop_1c(nbas, ndmem) + + if (master) write (luout,*) 'ndmem = ',ndmem +c dmem + if (.not. ma_push_get(mt_dbl, ndmem, + & 'dmem', l_dmem, k_dmem)) + & call errquit('x2cefg: failed allocation dmem', ndmem, + & MA_ERR) + + call dfill(nbas2, 0.0d0, dbl_mb(k_omP), 1) + + call relop_1c(nbas, + & dbl_mb(k_amP), + & dbl_mb(k_amQ), + & dbl_mb(k_amUL), + & dbl_mb(k_amUS), + & dbl_mb(k_omP), + & dbl_mb(k_dmem), ndmem) + +c delete dmem array + + if (.not.ma_pop_stack(l_dmem)) call + & errquit('x2c: ma_chop_stack failed k_dmem',l_dmem,MA_ERR) + +c ----------------------------------------- +c Sort output MA arrays into Property Operator GA +c ----------------------------------------- + + call ga_zero(g_P) + call ga_put(g_P,1,nbas,1,nbas, dbl_mb(k_omP), nbas) + +c ----------------------------------------- +c calculate electronic EFG again, this time +c using the transformed operator +c ----------------------------------------- + + moment(i) = 0.0d0 + + clo(1) = 1 + chi(1) = nbas + clo(2) = 1 + chi(2) = nbas + + + alo(1) = 1 + ahi(1) = nbas + alo(2) = 1 + ahi(2) = nbas + blo(1) = 1 + bhi(1) = nbas + blo(2) = 1 + bhi(2) = nbas + +c tr[P*Moment] + call ga_zero(g_temp) + call nga_matmul_patch('n','n',1d0,0d0, + & g_dscf(1),alo,ahi, + & g_P,blo,bhi, + & g_temp,clo,chi) + sum = ga_trace_diag(g_temp) + moment(i) = moment(i) + sum + +c The GA g_P now has the picture-change transformed +c electric moment AO matrix for component no. i +c (as returned from int_mpole_1ega). +cng check if we need to save the g_P matrices for use in TDDFT +c + if (dosavepcdip) call write_x2c_pc_dip(i,g_P) ! save components +c + end do ! i = loop over moment components + +c print results: + + if (master) then + write (luout,*) + write (luout,*) 'X2C Moment: After picture-change corr.' + write (luout,'(1x,a,50e15.7)') 'moment = ', + & (moment(i), i=1,ncomp) + write (luout,*) + end if + +c -------------------- +c clean up some GA memory +c -------------------- + + + if (.not. ga_destroy(g_P)) call errquit + & ('x2c_moment: ga P corrupt?',666, GA_ERR) + + do j = 1,ncomp + if (.not. ga_destroy(g_w(j))) call errquit + & ('x2c_moment: failed destroying g_w',1+10*j, GA_ERR) + end do + + if (.not.ma_chop_stack(l_amP)) call errquit + & ('x2c_moment: ma_chop_stack l_amP failed',911,MA_ERR) + + 8000 continue + + if (.not. ga_destroy(g_temp)) call errquit + & ('x2c_moment: ga corrupt?',12, GA_ERR) + + + if (.not. ga_destroy(g_int)) call errquit ('x2cefg: ga corrupt?' + & ,11, GA_ERR) + + +c undo addition of alpha and beta density matrix: + + if (ipol.gt.1) + & call ga_dadd(1.d0, g_dscf(1), -1.d0, g_dscf(2), g_dscf(1)) + +c -------- +c all done +c -------- + + call ga_sync() + + if (dbg>0.and.master) write(luout,*) 'leaving x2c_moment' + +c ================================================================= + + return + end + diff --git a/src/nwdft/x2c/calc_x2c_w_scalar.F b/src/nwdft/x2c/calc_x2c_w_scalar.F new file mode 100644 index 0000000000..46b7715308 --- /dev/null +++ b/src/nwdft/x2c/calc_x2c_w_scalar.F @@ -0,0 +1,189 @@ +c +c == calculate scalar x2c contribution == + subroutine calc_x2c_w_scalar ( + & ao_bas_han, ! in: AO basis handle + & geom, ! in: geometry handle + & ipol, ! in: nr. of spin components in g_dens + & g_dens, ! in: atomic superposition density + & skipnuc, ! in: whether to exclude nuclear potential + & skipcoul, ! in: whether to skip atomic Hartree pot. + & delchi_ao, ! in: derivatives of basis fcts. + & qxyz, ! in: grid points + & qwght, ! in: weight coefficients + & nbf, ! in: nr. basis functions + & npts, ! in: nr. grid points + & natoms, ! in: nr. atoms + & x2c0) ! out: W0 + + implicit none +#include "errquit.fh" +#include "mafdecls.fh" +#include "stdio.fh" +cinclude "x2c.fh" +#include "global.fh" +#include "bas.fh" +c + integer nbf,npts,ao_bas_han,natoms,geom + logical skipnuc, skipcoul + integer g_dens(2),ipol + double precision qwght(npts) + double precision pot(npts) + double precision qxyz(3,npts) + double precision delchi_ao(npts,3,nbf) + + double precision x2c0(nbf,nbf) + + integer i,j,k + double precision amat_coul(npts,ipol) + double precision amat_nucl(npts) + integer ipt,closegridpts(npts) + double precision clight_au2,tol + double precision amat_tot + double precision denom + double precision fac1_arr(npts) + double precision ac_sf + external get_ints_x2c_scalar + + integer dbg + +c ================================================================= + + dbg = 0 + +c debug: + if (ga_nodeid().eq.0 .and. dbg>0) then + write (luout,*) 'hello from calc_x2c_w_scalar' + write (luout,*) 'skipnuc, skipcoul = ',skipnuc, skipcoul + end if + +c == preliminaries == + do ipt = 1,npts + amat_coul(ipt,1) = 0.d0 + if (ipol.gt.1) amat_coul(ipt,2) = 0.d0 + amat_nucl(ipt) = 0.d0 + closegridpts(ipt) = 0 + end do + + tol = 1d-8 + + +c calculate sum of atomic Hartree potentials, if +c the skipcoul option is not set: + + if (.not.skipcoul) then + do i=1,ipol + call potential_list(ao_bas_han, g_dens(i), npts, qxyz, + & amat_coul(1,i), tol) + enddo + if (ipol.gt.1) then ! enter-ONLY-if ipol>1 + do k = 1,npts + amat_coul(k,1)=amat_coul(k,1)+amat_coul(k,2) + enddo + endif + +c write (luout,*) 'x2chscale =', x2chscale + +c scale Hartree potential globally if requested by input +c$$$ if (scale_x2c_hartree) then +c$$$ do k = 1,npts +c$$$ amat_coul(k,1)=amat_coul(k,1) * x2chscale +c$$$ end do +c$$$ end if + + else + if (ga_nodeid().eq.0 .and. dbg>0) + & write (luout,*) 'calc_x2c_w_sc: skipped Coul. pot' + end if ! .not.skipcoul + + +c calculate the total point nuclear potential on the grid +c if the option skipnuc is not set + + if (.not.skipnuc) then + call gridNuclearPotentialPoint(geom,natoms,npts,qxyz,qwght, + & closegridpts,amat_nucl) + do k = 1,npts + if (k.eq.closegridpts(k)) qwght(k) = 0.d0 + end do + else + if (ga_nodeid().eq.0 .and. dbg>0) + & write (luout,*) 'calc_x2c_w_sc: skipped nuc. pot' + end if ! .not.skipnuc + +c === define fac1_arr + do k = 1,npts +c == assemble hartree and nuclear contributions == +c == and pre-multiply with grid point weight factor == + amat_tot =-amat_coul(k,1)+amat_nucl(k) + fac1_arr(k)=amat_tot * qwght(k) + end do + +c scale Hartree potential if requested by input +c (caution, it may have been scaled already once, see above) +c$$$ if (scale_x2c_so_hartree) then +c$$$ write (luout,*) 'x2csoscale =', x2csoscale +c$$$ do k = 1,npts +c$$$ amat_coul(k,1)=amat_coul(k,1) * x2csoscale +c$$$ end do +c$$$ end if + + +c == assemble x2c correction == +c ----- main diagonal --- START + do i = 1, nbf + j=i + call get_ints_x2c_scalar(nbf,npts,delchi_ao,i,j, + & fac1_arr, + & ac_sf) ! out + x2c0(i,j) = x2c0(i,j) + ac_sf + enddo ! end-loop-i +c ----- main diagonal --- END +c ----- off diagonal --- START + do i = 1, nbf + do j = i+1, nbf + call get_ints_x2c_scalar(nbf,npts,delchi_ao,i,j, + & fac1_arr, + & ac_sf) ! out + x2c0(i,j) = x2c0(i,j) + 2.0d0*ac_sf + enddo ! end-loop-j + enddo ! end-loop-i +c ----- off diagonal --- END + + if (ga_nodeid().eq.0 .and. dbg>0) then + write (luout,*) 'leaving calc_x2c_w_scalar' + end if + + return + end + + subroutine get_ints_x2c_scalar( + & nbf, ! in: # basis fncts. + & npts, ! in: grid points + & delchi_ao, ! in: deriv. of basis fcts. + & i,j, ! in: (i,j) indices for delchi_ao + & fac1_arr, ! in + & ac_sf) ! out +c + implicit none +#include "errquit.fh" +#include "stdio.fh" +#include "global.fh" + integer nbf,npts,i,j,k + double precision delchi_ao(npts,3,nbf) + double precision fac1_arr(npts) + double precision ac_sf + double precision prod0 + + ac_sf = 0.0d0 + + do k = 1, npts + prod0 = delchi_ao(k,1,i)*delchi_ao(k,1,j) + & +delchi_ao(k,2,i)*delchi_ao(k,2,j) + & +delchi_ao(k,3,i)*delchi_ao(k,3,j) + + ac_sf = ac_sf + fac1_arr(k)*prod0 + + end do ! k + return + end + diff --git a/src/nwdft/x2c/calc_x2c_wefg_scalar.F b/src/nwdft/x2c/calc_x2c_wefg_scalar.F new file mode 100644 index 0000000000..eae7c51451 --- /dev/null +++ b/src/nwdft/x2c/calc_x2c_wefg_scalar.F @@ -0,0 +1,152 @@ +c +c calculate EFG operator matrix in small component basis, for x2c + subroutine calc_x2c_wefg_scalar( + & ao_bas_han, ! in: AO basis handle + & geom, ! in: geometry handle + & ipol, ! in: nr. of polarizations + & g_dens, ! in: superposit. atomic + & delchi_ao, ! in: deriv. basis fcts. + & qxyz, ! in: grid points + & qwght, ! in: weighting coeffs. + & nbf, ! in: nr. basis functions + & npts, ! in: nr. grid points + & natoms, ! in: nr. atoms + & origin, ! in: EFG center + & x2c0) ! out + implicit none +#include "errquit.fh" +#include "mafdecls.fh" +#include "stdio.fh" +cinclude "x2c.fh" +#include "global.fh" +#include "bas.fh" +c + integer nbf,npts,ao_bas_han,natoms,geom + integer g_dens(2),ipol + double precision qwght(npts) + double precision pot(npts) + double precision qxyz(3,npts) + double precision delchi_ao(npts,3,nbf) + double precision origin(3) + + double precision x2c0(nbf,nbf,6) + + integer i,j,k, iefg + + integer closegridpts(npts) + double precision clight_au2 + double precision amat_tot + double precision denom + double precision fac1_arr(npts,6) + + double precision ac_sf(6) + + external get_ints_x2c_so_efg + +c == preliminaries == + do k = 1,npts + closegridpts(k) = 0 + end do + + do iefg = 1,6 + do k = 1,npts + fac1_arr(k,iefg) = 0.0d0 + end do + end do + +c == calculate the EFG operator on the grid == + + call gridQpqPotential_all(origin, + & npts,qxyz, + & fac1_arr, ! out: EFG potential + & closegridpts) + +c black out grid points too close to a nucleus; +c the numerical integration may get noisy otherwise: + + do k = 1,npts + if (k.eq.closegridpts(k)) qwght(k) = 0.d0 + end do + +c === premultiply fac1_arr with integration weights + do iefg = 1,6 + do k = 1,npts + fac1_arr(k,iefg)= fac1_arr(k,iefg) * qwght(k) + end do + end do + +c == assemble integrals == + +c ----- main diagonal --- START + do i = 1, nbf + j=i + call get_ints_x2c_sc_efg( + & nbf,npts,delchi_ao,i,j, + & fac1_arr, + & ac_sf) ! out + + do iefg = 1,6 + x2c0(i,j,iefg) = x2c0(i,j,iefg) + ac_sf(iefg) + end do + enddo ! end-loop-i +c ----- main diagonal --- END + +c ----- off diagonal --- START + do i = 1, nbf + do j = i+1, nbf + call get_ints_x2c_sc_efg( + & nbf,npts,delchi_ao,i,j, + & fac1_arr, + & ac_sf) ! out + + do iefg = 1,6 + x2c0(i,j,iefg) = x2c0(i,j,iefg) + 2.0d0*ac_sf(iefg) + end do + enddo ! end-loop-j + enddo ! end-loop-i +c ----- off diagonal --- END + +c all done + return + end + + + subroutine get_ints_x2c_sc_efg( + & nbf, ! in: # basis fncts. + & npts, ! in: grid points + & delchi_ao, ! in: deriv. of basis fcts. + & i,j, ! in: (i,j) indices for delchi_ao + & fac1_arr, ! operator on grid points * weights + & ac_sf) ! out + + + implicit none +#include "errquit.fh" +#include "stdio.fh" +#include "global.fh" + integer nbf,npts,i,j,k, iefg + double precision delchi_ao(npts,3,nbf) + double precision fac1_arr(npts,6) + double precision + & ac_sf(6) + double precision prod0 + + do iefg = 1,6 + ac_sf(iefg) = 0.0d0 + end do + + do k = 1, npts + + prod0 = delchi_ao(k,1,i)*delchi_ao(k,1,j) + & +delchi_ao(k,2,i)*delchi_ao(k,2,j) + & +delchi_ao(k,3,i)*delchi_ao(k,3,j) + + do iefg = 1,6 + ac_sf(iefg) = ac_sf(iefg) + fac1_arr(k,iefg)*prod0 + end do ! iefg + + end do ! k + + return + end + diff --git a/src/nwdft/x2c/calc_x2c_wmoment_scalar.F b/src/nwdft/x2c/calc_x2c_wmoment_scalar.F new file mode 100644 index 0000000000..90eb0fb9dd --- /dev/null +++ b/src/nwdft/x2c/calc_x2c_wmoment_scalar.F @@ -0,0 +1,157 @@ +c +c calculate moment operator matrix in small component basis, for x2c + subroutine calc_x2c_wmoment_scalar( + & ao_bas_han, ! in: AO basis handle + & geom, ! in: geometry handle + & ipol, ! in: nr. of polarizations + & g_dens, ! in: superposit. atomic + & delchi_ao, ! in: deriv. basis fcts. + & qxyz, ! in: grid points + & qwght, ! in: weighting coeffs. + & nbf, ! in: nr. basis functions + & npts, ! in: nr. grid points + & natoms, ! in: nr. atoms + & origin, ! in: center + & type, ! in: moment type + & ncomp, ! in: no. of components + & x2c0) ! out + implicit none +#include "errquit.fh" +#include "mafdecls.fh" +#include "stdio.fh" +cinclude "x2c.fh" +#include "global.fh" +#include "bas.fh" +c + integer nbf,npts,ao_bas_han,natoms,ncomp,geom + integer g_dens(2),ipol + double precision qwght(npts) + double precision pot(npts) + double precision qxyz(3,npts) + double precision delchi_ao(npts,3,nbf) + double precision origin(3) + character*(*) type + double precision x2c0(nbf,nbf,ncomp) + + integer i,j,k, icomp + + integer closegridpts(npts) + double precision clight_au2 + double precision amat_tot + double precision denom + double precision fac1_arr(npts,ncomp) + + double precision ac_sf(6) + + external get_ints_x2c_so_efg + +c == preliminaries == + do k = 1,npts + closegridpts(k) = 0 + end do + + do icomp = 1,ncomp + do k = 1,npts + fac1_arr(k,icomp) = 0.0d0 + end do + end do + +c == calculate the EFG operator on the grid == + + + call grid_moments(origin,type,ncomp, + & npts,qxyz, + & fac1_arr, ! out: moments on grid + & closegridpts) + +c black out grid points too close to a nucleus; +c the numerical integration may get noisy otherwise: + +c$$$ do k = 1,npts +c$$$ if (k.eq.closegridpts(k)) qwght(k) = 0.d0 +c$$$ end do + +c === premultiply fac1_arr with integration weights + do icomp = 1,ncomp + do k = 1,npts + fac1_arr(k,icomp)= fac1_arr(k,icomp) * qwght(k) + end do + end do + +c == assemble integrals == + +c ----- main diagonal --- START + do i = 1, nbf + j=i + call get_ints_x2c_sc_moment( + & nbf,npts,delchi_ao,i,j,ncomp, + & fac1_arr, + & ac_sf) ! out + + do icomp = 1,ncomp + x2c0(i,j,icomp) = x2c0(i,j,icomp) + ac_sf(icomp) + end do + enddo ! end-loop-i +c ----- main diagonal --- END + +c ----- off diagonal --- START + do i = 1, nbf + do j = i+1, nbf + call get_ints_x2c_sc_moment( + & nbf,npts,delchi_ao,i,j,ncomp, + & fac1_arr, + & ac_sf) ! out + + do icomp = 1,ncomp + x2c0(i,j,icomp) = x2c0(i,j,icomp) + 2.0d0*ac_sf(icomp) + end do + enddo ! end-loop-j + enddo ! end-loop-i +c ----- off diagonal --- END + +c all done + return + end + + + subroutine get_ints_x2c_sc_moment( + & nbf, ! in: # basis fncts. + & npts, ! in: grid points + & delchi_ao, ! in: deriv. of basis fcts. + & i,j, ! in: (i,j) indices for delchi_ao + & ncomp, ! in: number of components, + & fac1_arr, ! operator on grid points * weights + & ac_sf) ! out + + + implicit none +#include "errquit.fh" +#include "stdio.fh" +#include "global.fh" + integer nbf,npts,i,j,ncomp + integer k, icomp + double precision delchi_ao(npts,3,nbf) + double precision fac1_arr(npts,ncomp) + double precision + & ac_sf(6) + double precision prod0 + + do icomp = 1,ncomp + ac_sf(icomp) = 0.0d0 + end do + + do k = 1, npts + + prod0 = delchi_ao(k,1,i)*delchi_ao(k,1,j) + & +delchi_ao(k,2,i)*delchi_ao(k,2,j) + & +delchi_ao(k,3,i)*delchi_ao(k,3,j) + + do icomp = 1,ncomp + ac_sf(icomp) = ac_sf(icomp) + fac1_arr(k,icomp)*prod0 + end do ! icomp + + end do ! k + + return + end + diff --git a/src/nwdft/x2c/read_x2c_pc_dip.F b/src/nwdft/x2c/read_x2c_pc_dip.F new file mode 100644 index 0000000000..414f874e33 --- /dev/null +++ b/src/nwdft/x2c/read_x2c_pc_dip.F @@ -0,0 +1,50 @@ +c + subroutine read_x2c_pc_dip(icomp,g_pcdip) +c + implicit none +c +#include "mafdecls.fh" +#include "global.fh" +#include "tcgmsg.fh" +#include "util.fh" +#include "stdio.fh" +#include "errquit.fh" +#include "msgids.fh" +#include "dra.fh" +#include "inp.fh" +#include "msgtypesf.h" +c + integer icomp + integer g_pcdip +c + character*(nw_max_path_len) fn_pcdip + character*3 ch_comp +c + logical dmat_from_file + external dmat_from_file +c + integer inntsize,ok +c +c prepare file name + call util_file_name('pcdip',.false.,.false.,fn_pcdip) + if (icomp.eq.1) ch_comp='.1' + if (icomp.eq.2) ch_comp='.2' + if (icomp.eq.3) ch_comp='.3' + fn_pcdip = fn_pcdip(1:inp_strlen(fn_pcdip))//ch_comp ! append component +c +c resolve path + call util_file_name_resolve(fn_pcdip, .false.) +c +c read ga from file + if (.not. dmat_from_file(g_pcdip,fn_pcdip)) + & call errquit('read_x2c_pc_dip: dmat_from_file',0, + & UNKNOWN_ERR) +c +c propagate status + ok = 1 + inntsize=MA_sizeof(MT_INT,1,MT_BYTE) + call ga_brdcst(Msg_Vec_Stat+MSGINT, ok, inntsize, 0) ! Propagate status + call ga_sync() +c + return + end diff --git a/src/nwdft/x2c/write_x2c_pc_dip.F b/src/nwdft/x2c/write_x2c_pc_dip.F new file mode 100644 index 0000000000..fc3a44e45e --- /dev/null +++ b/src/nwdft/x2c/write_x2c_pc_dip.F @@ -0,0 +1,41 @@ +c + subroutine write_x2c_pc_dip(icomp,g_pcdip) +c + implicit none +c +#include "mafdecls.fh" +#include "global.fh" +#include "tcgmsg.fh" +#include "util.fh" +#include "stdio.fh" +#include "errquit.fh" +#include "msgids.fh" +#include "dra.fh" +#include "inp.fh" +c + integer icomp + integer g_pcdip + + character*(nw_max_path_len) fn_pcdip + character*3 ch_comp +c + logical dmat_to_file + external dmat_to_file +c +c prepare file name + call util_file_name('pcdip',.false.,.false.,fn_pcdip) + if (icomp.eq.1) ch_comp='.1' + if (icomp.eq.2) ch_comp='.2' + if (icomp.eq.3) ch_comp='.3' + fn_pcdip = fn_pcdip(1:inp_strlen(fn_pcdip))//ch_comp ! append component +c +c resolve path name + call util_file_name_resolve(fn_pcdip, .false.) +c +c write ga to file + if (.not. dmat_to_file(g_pcdip, fn_pcdip)) + & call errquit('write_x2c_pc_dip: dmat_to_file error',0, + & UNKNOWN_ERR) +c + return + end diff --git a/src/nwdft/x2c/x2c_getw_efg_scalar.F b/src/nwdft/x2c/x2c_getw_efg_scalar.F new file mode 100644 index 0000000000..46b1114943 --- /dev/null +++ b/src/nwdft/x2c/x2c_getw_efg_scalar.F @@ -0,0 +1,266 @@ +c +c == compute the matrix elements for EFG operator in +c == small component basis, for x2c + + subroutine x2c_getw_efg_scalar(rtdb, g_dens, origin, + & g_w, + & nexc) +c +c modified from zora_getv_so + + implicit none +#include "rtdb.fh" +#include "bas.fh" +#include "cdft.fh" +#include "errquit.fh" +#include "mafdecls.fh" +#include "global.fh" +#include "geom.fh" +#include "msgtypesf.h" +#include "msgids.fh" +#include "stdio.fh" +#include "cgridfile.fh" +#include "grid_cube.fh" +c +c == arguments == + integer rtdb + integer g_dens(2) + double precision origin(3) ! [in] EFG center + integer g_w(6) ! [out] + integer nexc +c +c == local variables == + integer i,j,k,iefg,ind,nij + double precision rho_n + double precision tmat + double precision dummy(2) + integer iqsh, istep, nxyz, ncontrset + integer ixyz, lxyz, icharge, lcharge, itags, ltags + integer lrqbuf,irqbuf,lqxyz,iqxyz,lqwght,iqwght,nqpts,ncube, + & ictr_buf,iqpts + double precision rad,ke + integer lbas_cset_info, ibas_cset_info, + & lbas_cent_info, ibas_cent_info, + & ldocset, idocset, + & l_rchi_atom,i_rchi_atom, + & l_rq,i_rq,lniz, iniz, + & lchi_ao, ichi_ao, + & ldelchi_ao, idelchi_ao + integer lx2c ,ix2c + integer dbg + integer inntsize,ddblsize,ok + logical grid_file_rewind + external grid_file_rewind,ga_antisymmetrize + + logical me +c + me = (ga_nodeid().eq.0) + dbg=0 + + if (dbg>0 .and. me) write (luout,*) 'entering getw_efg' + +c == allocate memory == +c$$$ do i=1,4 +c$$$ do iefg = 1,6 +c$$$ if (.not.MA_Push_Get(mt_dbl,nbf_ao*nbf_ao, +c$$$ & 'x2ci',lx2c(i,iefg),ix2c(i,iefg))) +c$$$ & call errquit('x2c_getv_so: x2ci',i + iefg*10, MA_ERR) +c$$$ end do +c$$$ enddo + + if (.not.MA_Push_Get(mt_dbl, 6*(nbf_ao**2), + & 'x2ci',lx2c,ix2c)) + & call errquit('x2c_getv_so: x2ci', 6*(nbf_ao**2), MA_ERR) + +c == set output MA arrays to zero + +c$$$ do i = 1,4 +c$$$ do iefg = 1,6 +c$$$ call dfill(nbf_ao**2, 0.0d0, dbl_mb(ix2c(i,iefg)), 1) +c$$$ end do +c$$$ end do + + call dfill(6*(nbf_ao**2), 0.0d0, dbl_mb(ix2c), 1) + +c == generate the grid == + dummy(1) = 0.d0 + dummy(2) = 0.d0 +c g_w is a dummy array in the following call + if (dbg>0 .and.me) write (luout,*) 'calling grid_quadv0' + call grid_quadv0(rtdb,g_dens,g_w,nexc,rho_n,dummy,tmat) + if (me) write (luout,*) 'rho_n =',rho_n +c +c == ao basis set info used by xc_eval_basis == + if (.not.bas_numcont(AO_bas_han, ncontrset)) + & call errquit('x2c_getv_so:bas_numcont',0, BASIS_ERR) + if (.not.MA_Push_Get(mt_int, 3*ncenters, 'bas_cent_info', + & lbas_cent_info, ibas_cent_info)) + & call errquit('x2c_getv_so: cannot allocate bas_cent_info',0, + & MA_ERR) + if (.not.MA_Push_Get(mt_int, 6*ncontrset, 'bas_cset_info', + & lbas_cset_info, ibas_cset_info)) + & call errquit('x2c_getv_so: cannot allocate bas_cset_info',0, + & MA_ERR) + call xc_make_basis_info(AO_bas_han, int_mb(ibas_cent_info), + & int_mb(ibas_cset_info), ncenters) +c + if (.not.MA_Push_Get(mt_log, ncontrset, 'docset', + & ldocset, idocset)) + & call errquit('x2c_getv_so: cannot allocate ccdocset', + . ncontrset, MA_ERR) + do i=1,ncontrset + log_mb(idocset+i-1)=.true. + enddo + if(.not.MA_push_get(MT_int, ncenters, 'iniz', + & lniz, iniz)) + & call errquit("x2c_getv_so:iniz",0, MA_ERR) + do i= 1, ncenters + int_mb(iniz+i-1)=1 + enddo +c + nxyz = 3*ncenters + if (.not.MA_push_Get(MT_Dbl,nxyz,'xyz',lxyz,ixyz)) + & call errquit('x2c_getv_so: cannot allocate xyz',0, MA_ERR) + if (.not.MA_Push_Get(MT_Dbl,ncenters,'charge',lcharge,icharge)) + & call errquit('x2c_getv_so: cannot allocate charge',0, MA_ERR) + if (.not.MA_Push_Get(MT_Byte,ncenters*16,'tags',ltags,itags)) + & call errquit('x2c_getv_so: cannot allocate tags',0, MA_ERR) + if (.not. geom_cart_get(geom, ncenters, Byte_MB(itags), + & Dbl_MB(ixyz), Dbl_MB(icharge))) + & call errquit('x2c_getv_so: geom_cart_get failed',74, GEOM_ERR) + + if (.not.MA_Push_get(mt_dbl,3*n_per_rec,'qxyz',lqxyz,iqxyz)) + & call errquit('x2c_getv_so: cannot allocate qxyz',0, MA_ERR) + if (.not.MA_Push_get(mt_dbl,n_per_rec,'qwght',lqwght,iqwght)) + & call errquit('x2c_getv_so: cannot allocate qwght',0, MA_ERR) + if (.not.MA_Push_get(MT_dbl, 4*buffer_size+4, + & 'quad pts buffer', lrqbuf, irqbuf)) + & call errquit('x2c_getv_so: quad buffer', 3, MA_ERR) + + if (.not. grid_file_rewind()) + $ call errquit('x2c_getv_so: rewinding gridpts?', 0, + & UNKNOWN_ERR) +c +c == loop over records in the grid file == + do iqsh = 1, n_rec_in_file +c +c == define current range of rad. shells and integration center == + call grid_file_read(n_per_rec, nqpts, ictr_buf, + & rad,dbl_mb(irqbuf),nsubb) + + if(nqpts.gt.buffer_size) + & call errquit(' buffersize exceed by qpts ',nqpts, UNKNOWN_ERR) +c +c == loop over a subset of the grid == + istep=0 + do ncube=1,nsubb +c +c put buf into currently used arrays qxyz and qwght + call grid_repack(dbl_mb(irqbuf), dbl_mb(iqxyz), + & dbl_mb(iqwght), nqpts, rad,istep) + + if(nqpts.ne.0) then +c +c == compute the basis functions over the grid == + if(.not.MA_Push_get(MT_dbl, ncenters, 'rchi_atom', + & l_rchi_atom,i_rchi_atom)) + & call errquit("x2c_getv:rchi_atom",0, MA_ERR) +c + if(.not.MA_Push_get(MT_dbl, nqpts*ncenters, 'rq', + & l_rq,i_rq)) + & call errquit("x2c_getv_so:rq",0, MA_ERR) +c +c == delchi == + if (.not.MA_Push_Get(mt_dbl, 3*nqpts*nbf_ao, + & 'delchi_ao', ldelchi_ao, idelchi_ao)) + & call errquit('x2c_getv: delchi_ao',0, MA_ERR) +c +c == chi == + if (.not.MA_Push_Get(mt_dbl, nqpts*nbf_ao, + & 'chi_ao', lchi_ao, ichi_ao)) + & call errquit('x2c_getv: chi_ao',0, MA_ERR) + call qdist(dbl_mb(i_rchi_atom), dbl_mb(i_rq), + & dbl_mb(iqxyz), dbl_mb(ixyz), nqpts, ncenters) + call xc_eval_basis(ao_bas_han, 1, dbl_mb(ichi_ao), + & dbl_mb(idelchi_ao), 0d0, 0d0, dbl_mb(i_rq), + & dbl_mb(iqxyz), dbl_mb(ixyz), nqpts, ncenters, + & int_mb(iniz), log_mb(idocset), + & int_mb(ibas_cent_info), int_mb(ibas_cset_info)) +c +c calculate EFG integrals + if(dbg>0 .and. me) write (luout,*) 'calling wefg_sc' + call calc_x2c_wefg_scalar(ao_bas_han, geom, ipol, g_dens, + & dbl_mb(idelchi_ao), + & dbl_mb(iqxyz),dbl_mb(iqwght), + & nbf_ao, nqpts, ncenters, + & origin, + & dbl_mb(ix2c)) ! out + if(dbg>0 .and. me) write (luout,*) 'return from wefg_sc' + + +c == delete memory == + if(.not.MA_pop_stack(lchi_ao)) + & call errquit("x2c_getv: pop chi_ao", 100, MA_ERR) + if(.not.MA_pop_stack(ldelchi_ao)) + & call errquit("x2c_getv: pop delchi_ao", 100, MA_ERR) + if(.not.MA_pop_stack(l_rq)) + & call errquit("x2c_getv: pop rq", 100, MA_ERR) + if(.not.MA_pop_stack(l_rchi_atom)) + & call errquit("x2c_getv: pop rchi_atom",100,MA_ERR) + endif ! nqpts + enddo ! ncube + end do ! iqsh +c +c == delete memory == + if(.not.MA_pop_stack(lrqbuf)) + & call errquit("x2c_getv_so: pop rqbuf", 100, MA_ERR) + if(.not.MA_pop_stack(lqwght)) + & call errquit("x2c_getv_so: pop qwght", 100, MA_ERR) + if(.not.MA_pop_stack(lqxyz)) + & call errquit("x2c_getv_so: pop qxyz", 100, MA_ERR) + if(.not.MA_pop_stack(ltags)) + & call errquit("x2c_getv_so: pop tags", 100, MA_ERR) + if(.not.MA_pop_stack(lcharge)) + & call errquit("x2c_getv_so: pop charge", 100, MA_ERR) + if(.not.MA_pop_stack(lxyz)) + & call errquit("x2c_getv_so: pop xyz", 100, MA_ERR) + if(.not.MA_pop_stack(lniz)) + & call errquit("x2c_getv_so: pop niz", 100, MA_ERR) + if(.not.MA_pop_stack(ldocset)) + & call errquit("x2c_getv_so: pop docset", 100, MA_ERR) + if(.not.MA_pop_stack(lbas_cset_info)) + & call errquit("x2c_getv_so: pop bas_cset_info", 100, MA_ERR) + if(.not.MA_pop_stack(lbas_cent_info)) + & call errquit("x2c_getv_so: pop bas_cent_info", 100, MA_ERR) +c +c == tally up over all the nodes == + + nij = 0 + do i = 1, nbf_ao + do j = 1, nbf_ao + do iefg = 1,6 + nij = nij + 1 + call ga_dgop(msg_excrho,dbl_mb(ix2c +nij-1),1,'+') + end do + enddo + enddo + +c == pack into GA and symmetrize == + + do iefg = 1,6 + call ga_zero(g_w(iefg)) +c call ga_put(g_w(i,iefg),1,nbf_ao,1,nbf_ao, +c & dbl_mb(ix2c(i,iefg)),nbf_ao) + call ga_put(g_w(iefg),1,nbf_ao,1,nbf_ao, + & dbl_mb(ix2c + ((iefg-1)*(nbf_ao**2)) ),nbf_ao) + call ga_symmetrize(g_w(iefg)) + end do + call ga_sync() +c + if(.not.MA_chop_stack(lx2c)) + & call errquit("x2c_getv_so: pop lx2c", 100, MA_ERR) + + if (dbg>0 .and. me) write (luout,*) 'leaving getw_efg' +c + return + end diff --git a/src/nwdft/x2c/x2c_getw_moment_scalar.F b/src/nwdft/x2c/x2c_getw_moment_scalar.F new file mode 100644 index 0000000000..eca7bb5131 --- /dev/null +++ b/src/nwdft/x2c/x2c_getw_moment_scalar.F @@ -0,0 +1,249 @@ +c +c == compute the matrix elements for electric moment operator in +c == small component basis, for x2c + + subroutine x2c_getw_moment_scalar(rtdb, g_dens, origin, + & g_w, + & nexc, type, ncomp) +c +c modified from zora_getv_so + + implicit none +#include "rtdb.fh" +#include "bas.fh" +#include "cdft.fh" +#include "errquit.fh" +#include "mafdecls.fh" +#include "global.fh" +#include "geom.fh" +#include "msgtypesf.h" +#include "msgids.fh" +#include "stdio.fh" +#include "cgridfile.fh" +#include "grid_cube.fh" +c +c == arguments == + integer rtdb + integer g_dens(2) + double precision origin(3) ! [in] EFG center + integer nexc, ncomp + character*(*) type + integer g_w(ncomp) ! [out] +c +c == local variables == + integer i,j,k,icomp,ind,nij + double precision rho_n + double precision tmat + double precision dummy(2) + integer iqsh, istep, nxyz, ncontrset + integer ixyz, lxyz, icharge, lcharge, itags, ltags + integer lrqbuf,irqbuf,lqxyz,iqxyz,lqwght,iqwght,nqpts,ncube, + & ictr_buf,iqpts + double precision rad,ke + integer lbas_cset_info, ibas_cset_info, + & lbas_cent_info, ibas_cent_info, + & ldocset, idocset, + & l_rchi_atom,i_rchi_atom, + & l_rq,i_rq,lniz, iniz, + & lchi_ao, ichi_ao, + & ldelchi_ao, idelchi_ao + integer lx2c ,ix2c + integer dbg + integer inntsize,ddblsize,ok + logical grid_file_rewind + external grid_file_rewind,ga_antisymmetrize + + logical me +c + me = (ga_nodeid().eq.0) + dbg=1 + + if (dbg>0 .and. me) write (luout,*) 'entering getw_moment' + + if (.not.MA_Push_Get(mt_dbl, ncomp*(nbf_ao**2), + & 'x2ci',lx2c,ix2c)) + & call errquit('x2c_getv_so: x2ci', ncomp*(nbf_ao**2), MA_ERR) + + call dfill(ncomp*(nbf_ao**2), 0.0d0, dbl_mb(ix2c), 1) + +c == generate the grid == + dummy(1) = 0.d0 + dummy(2) = 0.d0 +c g_w is a dummy array in the following call + if (dbg>0 .and.me) write (luout,*) 'calling grid_quadv0' + call grid_quadv0(rtdb,g_dens,g_w,nexc,rho_n,dummy,tmat) + if (me) write (luout,*) 'rho_n =',rho_n +c +c == ao basis set info used by xc_eval_basis == + if (.not.bas_numcont(AO_bas_han, ncontrset)) + & call errquit('x2c_getv_so:bas_numcont',0, BASIS_ERR) + if (.not.MA_Push_Get(mt_int, 3*ncenters, 'bas_cent_info', + & lbas_cent_info, ibas_cent_info)) + & call errquit('x2c_getv_so: cannot allocate bas_cent_info',0, + & MA_ERR) + if (.not.MA_Push_Get(mt_int, 6*ncontrset, 'bas_cset_info', + & lbas_cset_info, ibas_cset_info)) + & call errquit('x2c_getv_so: cannot allocate bas_cset_info',0, + & MA_ERR) + call xc_make_basis_info(AO_bas_han, int_mb(ibas_cent_info), + & int_mb(ibas_cset_info), ncenters) +c + if (.not.MA_Push_Get(mt_log, ncontrset, 'docset', + & ldocset, idocset)) + & call errquit('x2c_getv_so: cannot allocate ccdocset', + . ncontrset, MA_ERR) + do i=1,ncontrset + log_mb(idocset+i-1)=.true. + enddo + if(.not.MA_push_get(MT_int, ncenters, 'iniz', + & lniz, iniz)) + & call errquit("x2c_getv_so:iniz",0, MA_ERR) + do i= 1, ncenters + int_mb(iniz+i-1)=1 + enddo +c + nxyz = 3*ncenters + if (.not.MA_push_Get(MT_Dbl,nxyz,'xyz',lxyz,ixyz)) + & call errquit('x2c_getv_so: cannot allocate xyz',0, MA_ERR) + if (.not.MA_Push_Get(MT_Dbl,ncenters,'charge',lcharge,icharge)) + & call errquit('x2c_getv_so: cannot allocate charge',0, MA_ERR) + if (.not.MA_Push_Get(MT_Byte,ncenters*16,'tags',ltags,itags)) + & call errquit('x2c_getv_so: cannot allocate tags',0, MA_ERR) + if (.not. geom_cart_get(geom, ncenters, Byte_MB(itags), + & Dbl_MB(ixyz), Dbl_MB(icharge))) + & call errquit('x2c_getv_so: geom_cart_get failed',74, GEOM_ERR) + + if (.not.MA_Push_get(mt_dbl,3*n_per_rec,'qxyz',lqxyz,iqxyz)) + & call errquit('x2c_getv_so: cannot allocate qxyz',0, MA_ERR) + if (.not.MA_Push_get(mt_dbl,n_per_rec,'qwght',lqwght,iqwght)) + & call errquit('x2c_getv_so: cannot allocate qwght',0, MA_ERR) + if (.not.MA_Push_get(MT_dbl, 4*buffer_size+4, + & 'quad pts buffer', lrqbuf, irqbuf)) + & call errquit('x2c_getv_so: quad buffer', 3, MA_ERR) + + if (.not. grid_file_rewind()) + $ call errquit('x2c_getv_so: rewinding gridpts?', 0, + & UNKNOWN_ERR) +c +c == loop over records in the grid file == + do iqsh = 1, n_rec_in_file +c +c == define current range of rad. shells and integration center == + call grid_file_read(n_per_rec, nqpts, ictr_buf, + & rad,dbl_mb(irqbuf),nsubb) + + if(nqpts.gt.buffer_size) + & call errquit(' buffersize exceed by qpts ',nqpts, UNKNOWN_ERR) +c +c == loop over a subset of the grid == + istep=0 + do ncube=1,nsubb +c +c put buf into currently used arrays qxyz and qwght + call grid_repack(dbl_mb(irqbuf), dbl_mb(iqxyz), + & dbl_mb(iqwght), nqpts, rad,istep) + + if(nqpts.ne.0) then +c +c == compute the basis functions over the grid == + if(.not.MA_Push_get(MT_dbl, ncenters, 'rchi_atom', + & l_rchi_atom,i_rchi_atom)) + & call errquit("x2c_getv:rchi_atom",0, MA_ERR) +c + if(.not.MA_Push_get(MT_dbl, nqpts*ncenters, 'rq', + & l_rq,i_rq)) + & call errquit("x2c_getv_so:rq",0, MA_ERR) +c +c == delchi == + if (.not.MA_Push_Get(mt_dbl, 3*nqpts*nbf_ao, + & 'delchi_ao', ldelchi_ao, idelchi_ao)) + & call errquit('x2c_getv: delchi_ao',0, MA_ERR) +c +c == chi == + if (.not.MA_Push_Get(mt_dbl, nqpts*nbf_ao, + & 'chi_ao', lchi_ao, ichi_ao)) + & call errquit('x2c_getv: chi_ao',0, MA_ERR) + call qdist(dbl_mb(i_rchi_atom), dbl_mb(i_rq), + & dbl_mb(iqxyz), dbl_mb(ixyz), nqpts, ncenters) + call xc_eval_basis(ao_bas_han, 1, dbl_mb(ichi_ao), + & dbl_mb(idelchi_ao), 0d0, 0d0, dbl_mb(i_rq), + & dbl_mb(iqxyz), dbl_mb(ixyz), nqpts, ncenters, + & int_mb(iniz), log_mb(idocset), + & int_mb(ibas_cent_info), int_mb(ibas_cset_info)) +c +c calculate integrals + if(me) write (luout,*) 'calling wmoment_sc' + call calc_x2c_wmoment_scalar( + & ao_bas_han, geom, ipol, g_dens, + & dbl_mb(idelchi_ao), + & dbl_mb(iqxyz),dbl_mb(iqwght), + & nbf_ao, nqpts, ncenters, + & origin,type,ncomp, + & dbl_mb(ix2c)) ! out + if(me) write (luout,*) 'return from wmoment_sc' + + +c == delete memory == + if(.not.MA_pop_stack(lchi_ao)) + & call errquit("x2c_getv: pop chi_ao", 100, MA_ERR) + if(.not.MA_pop_stack(ldelchi_ao)) + & call errquit("x2c_getv: pop delchi_ao", 100, MA_ERR) + if(.not.MA_pop_stack(l_rq)) + & call errquit("x2c_getv: pop rq", 100, MA_ERR) + if(.not.MA_pop_stack(l_rchi_atom)) + & call errquit("x2c_getv: pop rchi_atom",100,MA_ERR) + endif ! nqpts + enddo ! ncube + end do ! iqsh +c +c == delete memory == + if(.not.MA_pop_stack(lrqbuf)) + & call errquit("x2c_getv_so: pop rqbuf", 100, MA_ERR) + if(.not.MA_pop_stack(lqwght)) + & call errquit("x2c_getv_so: pop qwght", 100, MA_ERR) + if(.not.MA_pop_stack(lqxyz)) + & call errquit("x2c_getv_so: pop qxyz", 100, MA_ERR) + if(.not.MA_pop_stack(ltags)) + & call errquit("x2c_getv_so: pop tags", 100, MA_ERR) + if(.not.MA_pop_stack(lcharge)) + & call errquit("x2c_getv_so: pop charge", 100, MA_ERR) + if(.not.MA_pop_stack(lxyz)) + & call errquit("x2c_getv_so: pop xyz", 100, MA_ERR) + if(.not.MA_pop_stack(lniz)) + & call errquit("x2c_getv_so: pop niz", 100, MA_ERR) + if(.not.MA_pop_stack(ldocset)) + & call errquit("x2c_getv_so: pop docset", 100, MA_ERR) + if(.not.MA_pop_stack(lbas_cset_info)) + & call errquit("x2c_getv_so: pop bas_cset_info", 100, MA_ERR) + if(.not.MA_pop_stack(lbas_cent_info)) + & call errquit("x2c_getv_so: pop bas_cent_info", 100, MA_ERR) +c +c == tally up over all the nodes == + + nij = 0 + do i = 1, nbf_ao + do j = 1, nbf_ao + do icomp = 1,ncomp + nij = nij + 1 + call ga_dgop(msg_excrho,dbl_mb(ix2c +nij-1),1,'+') + end do + enddo + enddo + +c == pack into GA and symmetrize == + + do icomp = 1,ncomp + call ga_zero(g_w(icomp)) + call ga_put(g_w(icomp),1,nbf_ao,1,nbf_ao, + & dbl_mb(ix2c + ((icomp-1)*(nbf_ao**2)) ),nbf_ao) + call ga_symmetrize(g_w(icomp)) + end do + call ga_sync() +c + if(.not.MA_chop_stack(lx2c)) + & call errquit("x2c_getv_so: pop lx2c", 100, MA_ERR) + + if (dbg>0 .and. me) write (luout,*) 'leaving getw_moment' +c + return + end diff --git a/src/nwdft/x2c/x2c_getw_scalar.F b/src/nwdft/x2c/x2c_getw_scalar.F new file mode 100644 index 0000000000..663f2be486 --- /dev/null +++ b/src/nwdft/x2c/x2c_getw_scalar.F @@ -0,0 +1,262 @@ +c +c == compute the matrix elements for scalar x2c == + subroutine x2c_getw_scalar(rtdb, g_dens, + & g_w, g_v, + & nexc, skipnuc, skipcoul) +c +c modified from zora_getv type routines + + implicit none +#include "rtdb.fh" +#include "bas.fh" +#include "cdft.fh" +#include "errquit.fh" +#include "mafdecls.fh" +#include "global.fh" +#include "geom.fh" +#include "msgtypesf.h" +#include "msgids.fh" +#include "stdio.fh" +#include "cgridfile.fh" +#include "grid_cube.fh" +c +c == arguments == + integer rtdb ! [inp] runtime database GA handle + integer g_dens(2) ! [inp] model pot. density matrix + integer g_w ! [out] W-matrix (=pV.p) + integer g_v(4) ! scratch + integer nexc ! dummy needed for numerical integration code + logical skipnuc ! [inp] whether to skip nuclear potential + logical skipcoul ! [inp] whether to skip atomic Hartree pot +c +c == local variables == + integer i,j,k,ind,nij + double precision rho_n + double precision tmat + double precision dummy(2) + integer iqsh, istep, nxyz, ncontrset + integer ixyz, lxyz, icharge, lcharge, itags, ltags + integer lrqbuf,irqbuf,lqxyz,iqxyz,lqwght,iqwght,nqpts,ncube, + & ictr_buf,iqpts + double precision rad,ke + integer lbas_cset_info, ibas_cset_info, + & lbas_cent_info, ibas_cent_info, + & ldocset, idocset, + & l_rchi_atom,i_rchi_atom, + & l_rq,i_rq,lniz, iniz, + & lchi_ao, ichi_ao, + & ldelchi_ao, idelchi_ao + integer lx2c,ix2c + integer inntsize,ddblsize,ok + + integer g_tmp + + logical grid_file_rewind + external grid_file_rewind,ga_antisymmetrize + +c ================================================================ + + if (skipnuc .and. skipcoul) then + if (ga_nodeid().eq.0) write (luout,*) + & 'x2c_getw_scalar: noting to do. Input error?' + call errquit ('X2C_GETW_SC skipnuc=T, skipcoul=T', 1, + & INPUT_ERR) + end if + +c debug: + if (ga_nodeid().eq.0) then + write (luout,*) 'hello from x2c_getw_scalar' + write (luout,*) 'skipnuc, skipcoul = ',skipnuc, skipcoul + end if + +c == allocate memory == + if (.not.MA_Push_Get(mt_dbl,nbf_ao*nbf_ao, + & 'x2ci',lx2c,ix2c)) + & call errquit('x2c_getv_scalar: x2ci',666, MA_ERR) + +c == preliminaries == + do i= 1, nbf_ao*nbf_ao + dbl_mb(ix2c+i-1)=0.d0 + enddo +c == generate the grid == + dummy(1) = 0.d0 + dummy(2) = 0.d0 + +c g_v is a scratch array in the following call, must +c have dimension (4) + + call grid_quadv0(rtdb,g_dens,g_v,nexc,rho_n,dummy,tmat) + if (ga_nodeid().eq.0) write (luout,*) 'rho_n =',rho_n +c +c == ao basis set info used by xc_eval_basis == + if (.not.bas_numcont(AO_bas_han, ncontrset)) + & call errquit('x2c_getv_sc:bas_numcont',0, BASIS_ERR) + if (.not.MA_Push_Get(mt_int, 3*ncenters, 'bas_cent_info', + & lbas_cent_info, ibas_cent_info)) + & call errquit('x2c_getv_sc: cannot allocate bas_cent_info',0, + & MA_ERR) + if (.not.MA_Push_Get(mt_int, 6*ncontrset, 'bas_cset_info', + & lbas_cset_info, ibas_cset_info)) + & call errquit('x2c_getv_sc: cannot allocate bas_cset_info',0, + & MA_ERR) + call xc_make_basis_info(AO_bas_han, int_mb(ibas_cent_info), + & int_mb(ibas_cset_info), ncenters) +c + if (.not.MA_Push_Get(mt_log, ncontrset, 'docset', + & ldocset, idocset)) + & call errquit('x2c_getv_sc: cannot allocate ccdocset', + . ncontrset, MA_ERR) + do i=1,ncontrset + log_mb(idocset+i-1)=.true. + enddo + if(.not.MA_push_get(MT_int, ncenters, 'iniz', + & lniz, iniz)) + & call errquit("x2c_getv_sc:iniz",0, MA_ERR) + do i= 1, ncenters + int_mb(iniz+i-1)=1 + enddo +c + nxyz = 3*ncenters + if (.not.MA_push_Get(MT_Dbl,nxyz,'xyz',lxyz,ixyz)) + & call errquit('x2c_getv_sc: cannot allocate xyz',0, MA_ERR) + if (.not.MA_Push_Get(MT_Dbl,ncenters,'charge',lcharge,icharge)) + & call errquit('x2c_getv_sc: cannot allocate charge',0, MA_ERR) + if (.not.MA_Push_Get(MT_Byte,ncenters*16,'tags',ltags,itags)) + & call errquit('x2c_getv_sc: cannot allocate tags',0, MA_ERR) + if (.not. geom_cart_get(geom, ncenters, Byte_MB(itags), + & Dbl_MB(ixyz), Dbl_MB(icharge))) + & call errquit('x2c_getv_sc: geom_cart_get failed',74, GEOM_ERR) + + if (.not.MA_Push_get(mt_dbl,3*n_per_rec,'qxyz',lqxyz,iqxyz)) + & call errquit('x2c_getv_sc: cannot allocate qxyz',0, MA_ERR) + if (.not.MA_Push_get(mt_dbl,n_per_rec,'qwght',lqwght,iqwght)) + & call errquit('x2c_getv_sc: cannot allocate qwght',0, MA_ERR) + if (.not.MA_Push_get(MT_dbl, 4*buffer_size+4, + & 'quad pts buffer', lrqbuf, irqbuf)) + & call errquit('x2c_getv_sc: quad buffer', 3, MA_ERR) + + if (.not. grid_file_rewind()) + $ call errquit('x2c_getv_sc: rewinding gridpts?', 0, + & UNKNOWN_ERR) +c +c == loop over records in the grid file == + do iqsh = 1, n_rec_in_file +c +c == define the current range of radial shells and integration center == + call grid_file_read(n_per_rec, nqpts, ictr_buf, + & rad,dbl_mb(irqbuf),nsubb) + + if(nqpts.gt.buffer_size) + & call errquit(' buffersize exceed by qpts ',nqpts, UNKNOWN_ERR) +c +c == loop over a subset of the grid == + istep=0 + do ncube=1,nsubb +c +c put buf into currently used arrays qxyz and qwght + call grid_repack(dbl_mb(irqbuf), dbl_mb(iqxyz), + & dbl_mb(iqwght), nqpts, rad,istep) + + if(nqpts.ne.0) then +c +c == compute the basis functions over the grid == + if(.not.MA_Push_get(MT_dbl, ncenters, 'rchi_atom', + & l_rchi_atom,i_rchi_atom)) + & call errquit("x2c_getv:rchi_atom",0, MA_ERR) +c + if(.not.MA_Push_get(MT_dbl, nqpts*ncenters, 'rq', + & l_rq,i_rq)) + & call errquit("x2c_getv_sc:rq",0, MA_ERR) +c +c == delchi == + if (.not.MA_Push_Get(mt_dbl, 3*nqpts*nbf_ao, + & 'delchi_ao', ldelchi_ao, idelchi_ao)) + & call errquit('x2c_getv: delchi_ao',0, MA_ERR) +c +c == chi == + if (.not.MA_Push_Get(mt_dbl, nqpts*nbf_ao, + & 'chi_ao', lchi_ao, ichi_ao)) + & call errquit('x2c_getv: chi_ao',0, MA_ERR) + call qdist(dbl_mb(i_rchi_atom), dbl_mb(i_rq), + & dbl_mb(iqxyz), dbl_mb(ixyz), nqpts, ncenters) + call xc_eval_basis(ao_bas_han, 1, dbl_mb(ichi_ao), + & dbl_mb(idelchi_ao), 0d0, 0d0, dbl_mb(i_rq), + & dbl_mb(iqxyz), dbl_mb(ixyz), nqpts, ncenters, + & int_mb(iniz), log_mb(idocset), + & int_mb(ibas_cent_info), int_mb(ibas_cset_info)) +c +c == calculate spin-orbit x2c integrals (pVp) == + call calc_x2c_w_scalar( + & ao_bas_han, geom, ipol, g_dens, skipnuc, skipcoul, + & dbl_mb(idelchi_ao), + & dbl_mb(iqxyz),dbl_mb(iqwght), + & nbf_ao, nqpts, ncenters, + & dbl_mb(ix2c)) ! out + +c == delete memory == + if(.not.MA_pop_stack(lchi_ao)) + & call errquit("x2c_getv: pop chi_ao", 100, MA_ERR) + if(.not.MA_pop_stack(ldelchi_ao)) + & call errquit("x2c_getv: pop delchi_ao", 100, MA_ERR) + if(.not.MA_pop_stack(l_rq)) + & call errquit("x2c_getv: pop rq", 100, MA_ERR) + if(.not.MA_pop_stack(l_rchi_atom)) + & call errquit("x2c_getv: pop rchi_atom",100,MA_ERR) + endif ! nqpts + enddo ! ncube + end do ! iqsh +c +c == delete memory == + if(.not.MA_pop_stack(lrqbuf)) + & call errquit("x2c_getv_sc: pop rqbuf", 100, MA_ERR) + if(.not.MA_pop_stack(lqwght)) + & call errquit("x2c_getv_sc: pop qwght", 100, MA_ERR) + if(.not.MA_pop_stack(lqxyz)) + & call errquit("x2c_getv_sc: pop qxyz", 100, MA_ERR) + if(.not.MA_pop_stack(ltags)) + & call errquit("x2c_getv_sc: pop tags", 100, MA_ERR) + if(.not.MA_pop_stack(lcharge)) + & call errquit("x2c_getv_sc: pop charge", 100, MA_ERR) + if(.not.MA_pop_stack(lxyz)) + & call errquit("x2c_getv_sc: pop xyz", 100, MA_ERR) + if(.not.MA_pop_stack(lniz)) + & call errquit("x2c_getv_sc: pop niz", 100, MA_ERR) + if(.not.MA_pop_stack(ldocset)) + & call errquit("x2c_getv_sc: pop docset", 100, MA_ERR) + if(.not.MA_pop_stack(lbas_cset_info)) + & call errquit("x2c_getv_sc: pop bas_cset_info", 100, MA_ERR) + if(.not.MA_pop_stack(lbas_cent_info)) + & call errquit("x2c_getv_sc: pop bas_cent_info", 100, MA_ERR) +c +c == tally up over all the nodes == + nij = 0 + do i = 1, nbf_ao + do j = 1, nbf_ao + nij = nij + 1 + call ga_dgop(msg_excrho, dbl_mb(ix2c+nij-1), 1, '+') + enddo + enddo + +c == pack into GA and symmetrize == +c Note: we need to ADD to the g_w GA because it may alreday hold +c analytic W integrals with the nuclear potential + + if(.not.ga_create(mt_dbl,nbf_ao,nbf_ao,'getw_tmp',0,0, g_tmp)) + & call errquit('x2c_getw_sc: error cdreating tmp GA',2, GA_ERR) + + call ga_zero(g_tmp) + call ga_put(g_tmp,1,nbf_ao,1,nbf_ao, + & dbl_mb(ix2c),nbf_ao) + call ga_symmetrize(g_tmp) + call ga_add(1.0d0, g_w, 1.0d0, g_tmp, g_w) + + if (.not. ga_destroy(g_tmp)) call errquit + & ('x2c_getw_sc: could not destroy g_tmp', 2, GA_ERR) + + call ga_sync() +c + if(.not.MA_chop_stack(lx2c)) + & call errquit("x2c_getv_sc: pop lx2c", 100, MA_ERR) +c + return + end diff --git a/src/nwdft/zora/GNUmakefile b/src/nwdft/zora/GNUmakefile index 5d93b65837..aa33f007a5 100644 --- a/src/nwdft/zora/GNUmakefile +++ b/src/nwdft/zora/GNUmakefile @@ -8,6 +8,7 @@ gridNuclearPotential.o\ gridHartreePotential.o\ gridQpqPotential.o\ + grid_moments.o\ zora_getv_EFGZ4_SR.o\ calc_zora_EFGZ4_SR.o\ zora_getv_EFGZ4_SO.o\ diff --git a/src/nwdft/zora/gridQpqPotential.F b/src/nwdft/zora/gridQpqPotential.F index e931fa8ca0..091699fa28 100644 --- a/src/nwdft/zora/gridQpqPotential.F +++ b/src/nwdft/zora/gridQpqPotential.F @@ -122,4 +122,81 @@ c == distance from the grid points to given xyz_EFGcoords() == endif return end -c $Id$ + + + subroutine gridQpqPotential_all( + & xyz_EFGcoords, ! in : EFG-nuclear coord. + & nqpts, ! in : nr. grid points + & qxyz, ! in : grid points + & amat_Qnucl, ! out: EFG potential + & closegridpts) +c Purpose: Evaluates Q_pq(\vec{r},\vec{r}') +c for all 6 unique pq simultaneously +c index = 1 -> Evaluates Qxx +c = 2 -> Evaluates Qyy +c = 3 -> Evaluates Qzz +c = 4 -> Evaluates Qxy +c = 5 -> Evaluates Qxz +c = 6 -> Evaluates Qyz +c nqpts , number of grid points +c qxyz , grid points +c xyz_EFGcoords, Quadrupole potential is evaluated +c in this point (\vec{r}) +c Output: +c amat_Qnucl, Quadrupole potential ev. in the grid +c for integration purpose (\vec{r}') +c +c Note: these are the traceless versions where xx is actually +c 3xx - rr, etc + + + implicit none +#include "global.fh" +#include "stdio.fh" +#include "zora.fh" + integer igrid,nqpts + integer closegridpts(*) + double precision xyz_EFGcoords(3) + double precision qxyz(3,nqpts) + double precision rx,ry,rz,dist,dist5 + double precision amat_Qnucl(nqpts,6) ! output + integer dbg + logical me + +c ================================================================= + + dbg = 0 + me = (ga_nodeid().eq.0) + if (dbg>0 .and. me) write (luout,*) 'gridQpq: cutoff =', + & zoracutoff_EFG + + +c == loop over the grid points == + + do igrid = 1,nqpts +c == distance from the grid points to given xyz_EFGcoords() == + rx = xyz_EFGcoords(1) - qxyz(1,igrid) + ry = xyz_EFGcoords(2) - qxyz(2,igrid) + rz = xyz_EFGcoords(3) - qxyz(3,igrid) + dist = dsqrt(rx*rx + ry*ry + rz*rz) + + if (dist.gt.zoracutoff_EFG) then ! check-cutoff + + dist5=dist*dist*dist*dist*dist + + amat_Qnucl(igrid,1) = (2.d0*rx*rx-(ry*ry+rz*rz))/dist5 + amat_Qnucl(igrid,2) = (2.d0*ry*ry-(rx*rx+rz*rz))/dist5 + amat_Qnucl(igrid,3) = (2.d0*rz*rz-(rx*rx+ry*ry))/dist5 + amat_Qnucl(igrid,4) = (3.d0*rx*ry)/dist5 + amat_Qnucl(igrid,5) = (3.d0*rx*rz)/dist5 + amat_Qnucl(igrid,6) = (3.d0*ry*rz)/dist5 + + else + closegridpts(igrid) = igrid + end if + end do ! end-grid + + return + end + +c $Id: gridQpqPotential.F 22517 2012-05-24 18:37:27Z jochen $ diff --git a/src/nwdft/zora/grid_moments.F b/src/nwdft/zora/grid_moments.F new file mode 100644 index 0000000000..ff01ad8baa --- /dev/null +++ b/src/nwdft/zora/grid_moments.F @@ -0,0 +1,57 @@ + + subroutine grid_moments( + & origin, ! in : origin + & type, ! in: integral type + & ncomp, ! in: no of components + & nqpts, ! in : nr. grid points + & qxyz, ! in : grid points + & amat, ! out: moments on grid + & closegridpts) + +c nqpts , number of grid points +c qxyz , grid points + + implicit none +#include "global.fh" +#include "stdio.fh" +#include "zora.fh" +#include "errquit.fh" + integer igrid,nqpts,ncomp + integer closegridpts(*) + double precision origin(3) + double precision qxyz(3,nqpts) + character*(*) type + double precision rx,ry,rz,dist + double precision amat(nqpts,ncomp) ! output + logical master + +c ================================================================= + + master = (ga_nodeid().eq.0) + if (master) write (luout,*) 'grid_moments: cutoff =', + & zoracutoff_EFG + + +c == loop over the grid points == + + do igrid = 1,nqpts +c == distance from the grid points to given origin == + rx = qxyz(1,igrid)-origin(1) + ry = qxyz(2,igrid)-origin(2) + rz = qxyz(3,igrid)-origin(3) +c dist = dsqrt(rx*rx + ry*ry + rz*rz) + + if (ncomp.eq.3) then +c dipole + amat(igrid,1) = rx + amat(igrid,2) = ry + amat(igrid,3) = rz + else + call errquit("grid_moments: ncomp unsupported", 666, + & INPUT_ERR) + end if + + end do ! end-grid + + return + end From 3036e407db306af0e0742506e614c3b19034cb87 Mon Sep 17 00:00:00 2001 From: Jochen Autschbach Date: Thu, 27 Jan 2022 12:11:15 -0500 Subject: [PATCH 02/15] x2c: cleaned up scalar x2c property routines after initial import. --- src/nwdft/x2c/calc_x2c_efg_scalar.F | 168 ++++----------------- src/nwdft/x2c/calc_x2c_moment_scalar.F | 199 +++++++------------------ src/nwdft/x2c/x2c_getw_moment_scalar.F | 6 +- src/nwdft/zora/grid_moments.F | 5 +- 4 files changed, 88 insertions(+), 290 deletions(-) diff --git a/src/nwdft/x2c/calc_x2c_efg_scalar.F b/src/nwdft/x2c/calc_x2c_efg_scalar.F index a08ab57bc6..5e2fd63382 100644 --- a/src/nwdft/x2c/calc_x2c_efg_scalar.F +++ b/src/nwdft/x2c/calc_x2c_efg_scalar.F @@ -10,8 +10,7 @@ c For the time being we MUST use an uncontracted basis ! c Integrals are supposed to be initialized by the calling c routine. -c Driver (c) 2012 J. Autschbach, SUNY, jochena@buffalo.edu -c X2C 'relham' code (c) 2012 Daoling Peng +c Driver (c) 2012, 2022 J. Autschbach, SUNY, jochena@buffalo.edu c Approach: The transformation matrices g_u come from calc_x2c_1e c if certain options are set. @@ -58,17 +57,6 @@ c GA handles used for temp storage in this routine: c dimensioning arrays integer alo(3), ahi(3), blo(3), bhi(3), clo(3), chi(3) -c MA handles for arrays passed to relop routine: - integer l_dmem , k_dmem - integer l_amP , k_amP - integer l_amQ , k_amQ - integer l_omP , k_omP - integer l_amUL , k_amUL - integer l_amUS , k_amUS - -c MA handles for the EFG matrices in the small component basis - integer l_w(6), k_w(6) - c other MA handles integer l_xyzpt, k_xyzpt, l_zanpt, k_zanpt @@ -141,7 +129,7 @@ c make sure the input GAs have the correct dimension if (master.and.dbg>0) write (luout,*) 'x2c: nbas =',nbas nbas2 = nbas * nbas -c in light of the recent updates of the x2c code, it is +c in light of the recent updates of the x2c ham. code, it is c important to check that we are working with an uncontracted c basis here. c eventually, this will be fixed @@ -238,13 +226,6 @@ c that we don't want: call ga_scale(g_efgint, third) -c temporarily add alpha and beta density, we only need the -c sum here: !!! CAREFUL, -c TJHIS IS NOT CORRECT. SEE HFC ROUTINE - - if (ipol.gt.1) - & call ga_dadd(1.d0, g_dscf(1), 1.d0, g_dscf(2), g_dscf(1)) - if (dbg>1 .and.master) write (luout,*) 'x2c_efg before iat loop' c --------------------------------------- @@ -475,39 +456,6 @@ c (we'll calculate all 6 matrices in one go) & nexc) if (dbg>0.and.master) write (luout,*) 'return from getw' -c ----------------------------------- -c Allocate relop arrays with MA -c ----------------------------------- - -c amP - if (.not. ma_push_get(mt_dbl, nbas2, - & 'amP', l_amP, k_amP)) - & call errquit('x2c1e: failed allocation amP', nbas2, - & MA_ERR) - -c amQ - if (.not. ma_push_get(mt_dbl, nbas2, - & 'amQ0', l_amQ, k_amQ)) - & call errquit('x2c1e: failed allocation amQ', nbas2, - & MA_ERR) - -c amUL - if (.not. ma_push_get(mt_dbl, nbas2, - & 'amUL', l_amUL, k_amUL)) - & call errquit('x2c1e: failed allocation amUL', nbas2, - & MA_ERR) - -c amUS - if (.not. ma_push_get(mt_dbl, nbas2, - & 'amUS', l_amUS, k_amUS)) - & call errquit('x2c1e: failed allocation omUS', nbas2, - & MA_ERR) - -c omP - if (.not. ma_push_get(mt_dbl, nbas2, - & 'omPr', l_omP, k_omP)) - & call errquit('x2c1e: failed allocation omP', nbas2, - & MA_ERR) c -------------------- c allocate operator GA @@ -518,12 +466,8 @@ c -------------------- & call errquit( & 'x2c_efg: error creating g_P',666, GA_ERR) -c copy decoupling transformation into MA - - call dfill(nbas2, 0.0d0, dbl_mb(k_amUL), 1) - call dfill(nbas2, 0.0d0, dbl_mb(k_amUS), 1) - call ga_get(g_u(1),1,nbas,1,nbas, dbl_mb(k_amUL),nbas) - call ga_get(g_u(2),1,nbas,1,nbas, dbl_mb(k_amUS),nbas) +c + c ------------------------------------------------------------ c in a loop over the EFG components, transform the @@ -533,11 +477,9 @@ c ------------------------------------------------------------ do i = 1,6 ! loop over EFG components - call dfill(nbas2, 0.0d0, dbl_mb(k_amP), 1) - call dfill(nbas2, 0.0d0, dbl_mb(k_amQ), 1) - call dfill(nbas2, 0.0d0, dbl_mb(k_omP), 1) + call ga_zero(g_P) -c extract EFG component from GA: +c array bounds needed to extract EFG component from GA: alo(1) = 1 ahi(1) = nbas @@ -546,63 +488,38 @@ c extract EFG component from GA: alo(3) = i ahi(3) = i - blo(1) = nbas - blo(2) = 1 +c g_temp always uses the same dimensions clo, chi +c we use the same ones for g_u, g_P + clo(1) = 1 + chi(1) = nbas + clo(2) = 1 + chi(2) = nbas - call nga_get(g_efg, alo, ahi, dbl_mb(k_amP), blo) +c transform EFG operator -c extract EFG operator in small-component basis from GA +c UL' EFG UL, store in g_P - call ga_get(g_w(i),1,nbas,1,nbas,dbl_mb(k_amQ), nbas) - -c debug: - if (dbg>1 .and. i<4) then - if (master) then - write (luout,*) 'EFG matrix, nuc, comp',iat,i - call moutr(dbl_mb(k_amP),nbas,nbas,'R','EFG-mat') - write (luout,*) 'pEFGp matrix, nuc, comp',iat,i - call moutr(dbl_mb(k_amQ),nbas,nbas,'R','pEFGp-mat') - end if - end if - -c ------------------------------- -c allocate scratch memory, -c call the X2C relop routine -c ------------------------------- + call nga_matmul_patch('t','n',1d0,0d0, + & g_u(1),clo,chi, + & g_efg,alo,ahi, + & g_temp,clo,chi) - if (master) write(luout,*) 'calling RELOP routines' + call nga_matmul_patch('n','n',1d0,0d0, + & g_temp,clo,chi, + & g_u(1),clo,chi, + & g_P,clo,chi) - call mem_relop_1c(nbas, ndmem) - - if (master) write (luout,*) 'ndmem = ',ndmem -c dmem - if (.not. ma_push_get(mt_dbl, ndmem, - & 'dmem', l_dmem, k_dmem)) - & call errquit('x2cefg: failed allocation dmem', ndmem, - & MA_ERR) - - call dfill(nbas2, 0.0d0, dbl_mb(k_omP), 1) +c US' pEFGp US, add to g_P - call relop_1c(nbas, - & dbl_mb(k_amP), - & dbl_mb(k_amQ), - & dbl_mb(k_amUL), - & dbl_mb(k_amUS), - & dbl_mb(k_omP), - & dbl_mb(k_dmem), ndmem) - -c delete dmem array + call nga_matmul_patch('t','n',1d0,0d0, + & g_u(2),clo,chi, + & g_w(i),clo,chi, + & g_temp,clo,chi) - if (.not.ma_pop_stack(l_dmem)) call - & errquit('x2c: ma_chop_stack failed k_dmem',l_dmem,MA_ERR) - - -c ----------------------------------------- -c Sort output MA arrays into Property Operator GA -c ----------------------------------------- - - call ga_zero(g_P) - call ga_put(g_P,1,nbas,1,nbas, dbl_mb(k_omP), nbas) + call nga_matmul_patch('n','n',1d0,1d0, + & g_temp,clo,chi, + & g_u(2),clo,chi, + & g_P,clo,chi) c call ga_print(g_P) @@ -612,13 +529,6 @@ c using the transformed operator c ----------------------------------------- efgel(i) = 0.0d0 - -c g_temp always uses the same dimensions clo, chi - clo(1) = 1 - chi(1) = nbas - clo(2) = 1 - chi(2) = nbas - alo(1) = 1 ahi(1) = nbas @@ -670,10 +580,6 @@ c -------------------- if (.not. ga_destroy(g_w(j))) call errquit & ('x2cefg: failed destroying g_w',1+10*j, GA_ERR) end do - - if (.not.ma_chop_stack(l_amP)) call errquit - & ('x2c_efg: ma_chop_stack l_amP failed',911,MA_ERR) - c -------------------------------------------------------- c end loop over refernce points at which EFG is calculated @@ -685,18 +591,6 @@ c -------------------------------------------------------- if (.not. ga_destroy(g_efgint)) call errquit & ('x2cefg: ga corrupt?',11, GA_ERR) -c ------- Deallocate MA memory ------ -c - if (.not.ma_pop_stack(l_zanpt)) call errquit - & ('x2cefg, ma_pop_stack of l_zanpt failed',911,MA_ERR) - if (.not.ma_pop_stack(l_xyzpt)) call errquit - & ('x2cefg, ma_pop_stack of l_xyzpt failed',911,MA_ERR) - -c undo addition of alpha and beta density matrix: - - if (ipol.gt.1) - & call ga_dadd(1.d0, g_dscf(1), -1.d0, g_dscf(2), g_dscf(1)) - c -------- c all done c -------- diff --git a/src/nwdft/x2c/calc_x2c_moment_scalar.F b/src/nwdft/x2c/calc_x2c_moment_scalar.F index c5ee70cac6..18b97e6f22 100644 --- a/src/nwdft/x2c/calc_x2c_moment_scalar.F +++ b/src/nwdft/x2c/calc_x2c_moment_scalar.F @@ -10,8 +10,7 @@ c For the time being we MUST use an uncontracted basis ! c Integrals are supposed to be initialized by the calling c routine. -c Driver (c) 2012 J. Autschbach, SUNY, jochena@buffalo.edu -c X2C 'relham' code (c) 2012 Daoling Peng +c Driver (c) 2012,2022 J. Autschbach, SUNY, jochena@buffalo.edu c Approach: The transformation matrices g_u come from calc_x2c_1e c if certain options are set. @@ -63,13 +62,7 @@ c GA handles used for temp storage in this routine: c dimensioning arrays integer alo(3), ahi(3), blo(3), bhi(3), clo(3), chi(3) -c MA handles for arrays passed to relop routine: - integer l_dmem , k_dmem - integer l_amP , k_amP - integer l_amQ , k_amQ - integer l_omP , k_omP - integer l_amUL , k_amUL - integer l_amUS , k_amUS + double precision ga_trace_diag external ga_trace_diag @@ -132,17 +125,6 @@ c accval = 1d-25 c call int_acc_set(accval) -c check if we have the routines, otherwise return without -c doing anyhting: - -#ifdef NWCHEMX2C - continue -#else - if (master) write(luout,*) - & 'x2c_moment: NWCHEMX2C not defined. aborting' - return -#endif - basis = ao_bas_han ! AO basis handle c make sure the input GAs have the correct dimension @@ -155,7 +137,7 @@ c make sure the input GAs have the correct dimension if (master.and.dbg>0) write (luout,*) 'nbas =',nbas nbas2 = nbas * nbas -c in light of the recent updates of the x2c code, it is +c in light of the recent updates of the x2c ham. code, it is c important to check that we are working with an uncontracted c basis here. c eventually, this will be fixed @@ -168,11 +150,6 @@ c eventually, this will be fixed & 'x2c_moment: cannot currently use a contracted basis', & ntemp, BASIS_ERR) -c temporarily add alpha and beta density, we only need the -c sum here: - - if (ipol.gt.1) - & call ga_dadd(1.d0, g_dscf(1), 1.d0, g_dscf(2), g_dscf(1)) c coordinate origin @@ -264,11 +241,6 @@ c print results: & (moment(i), i=1,ncomp) write (luout,*) end if - -c --------------------------------------------------- -c calculate picture-change corrected EFG operator -c for the selected reference point (nuclear position) -c --------------------------------------------------- c allocate arrays to hold the AO matrices of the EFG c operator in the small-component basis @@ -294,39 +266,6 @@ c (we'll calculate all matrices in one go) & nexc, type, ncomp) if (dbg>0.and.master) write (luout,*) 'return from getw' -c ----------------------------------- -c Allocate relop arrays with MA -c ----------------------------------- - -c amP - if (.not. ma_push_get(mt_dbl, nbas2, - & 'amP', l_amP, k_amP)) - & call errquit('x2c1e: failed allocation amP', nbas2, - & MA_ERR) - -c amQ - if (.not. ma_push_get(mt_dbl, nbas2, - & 'amQ0', l_amQ, k_amQ)) - & call errquit('x2c1e: failed allocation amQ', nbas2, - & MA_ERR) - -c amUL - if (.not. ma_push_get(mt_dbl, nbas2, - & 'amUL', l_amUL, k_amUL)) - & call errquit('x2c1e: failed allocation amUL', nbas2, - & MA_ERR) - -c amUS - if (.not. ma_push_get(mt_dbl, nbas2, - & 'amUS', l_amUS, k_amUS)) - & call errquit('x2c1e: failed allocation omUS', nbas2, - & MA_ERR) - -c omP - if (.not. ma_push_get(mt_dbl, nbas2, - & 'omPr', l_omP, k_omP)) - & call errquit('x2c1e: failed allocation omP', nbas2, - & MA_ERR) c -------------------- c allocate operator GA @@ -337,12 +276,6 @@ c -------------------- & call errquit( & 'x2c_efg: error creating g_P',666, GA_ERR) -c copy decoupling transformation into MA - - call dfill(nbas2, 0.0d0, dbl_mb(k_amUL), 1) - call dfill(nbas2, 0.0d0, dbl_mb(k_amUS), 1) - call ga_get(g_u(1),1,nbas,1,nbas, dbl_mb(k_amUL),nbas) - call ga_get(g_u(2),1,nbas,1,nbas, dbl_mb(k_amUS),nbas) c ------------------------------------------------------------ c in a loop over the moment components, transform the @@ -351,79 +284,59 @@ c ------------------------------------------------------------ do i = 1,ncomp ! loop over components - call dfill(nbas2, 0.0d0, dbl_mb(k_amP), 1) - call dfill(nbas2, 0.0d0, dbl_mb(k_amQ), 1) - call dfill(nbas2, 0.0d0, dbl_mb(k_omP), 1) - -c extract moment component from GA: - - alo(1) = 1 - ahi(1) = nbas - alo(2) = 1 - ahi(2) = nbas - alo(3) = i - ahi(3) = i - - blo(1) = nbas - blo(2) = 1 - - call nga_get(g_int, alo, ahi, dbl_mb(k_amP), blo) - -c extract operator in small-component basis from GA - - call ga_get(g_w(i),1,nbas,1,nbas,dbl_mb(k_amQ), nbas) - -c ------------------------------- -c allocate scratch memory, -c call the X2C relop routine -c ------------------------------- - - if (master) write(luout,*) 'calling RELOP routines' - - call mem_relop_1c(nbas, ndmem) - - if (master) write (luout,*) 'ndmem = ',ndmem -c dmem - if (.not. ma_push_get(mt_dbl, ndmem, - & 'dmem', l_dmem, k_dmem)) - & call errquit('x2cefg: failed allocation dmem', ndmem, - & MA_ERR) - - call dfill(nbas2, 0.0d0, dbl_mb(k_omP), 1) - - call relop_1c(nbas, - & dbl_mb(k_amP), - & dbl_mb(k_amQ), - & dbl_mb(k_amUL), - & dbl_mb(k_amUS), - & dbl_mb(k_omP), - & dbl_mb(k_dmem), ndmem) - -c delete dmem array - - if (.not.ma_pop_stack(l_dmem)) call - & errquit('x2c: ma_chop_stack failed k_dmem',l_dmem,MA_ERR) - -c ----------------------------------------- -c Sort output MA arrays into Property Operator GA -c ----------------------------------------- + call ga_zero(g_P) + +c array bounds needed to extract EFG component from GA: + + alo(1) = 1 + ahi(1) = nbas + alo(2) = 1 + ahi(2) = nbas + alo(3) = i + ahi(3) = i + +c g_temp always uses the same dimensions clo, chi +c we use the same ones for g_u, g_P + clo(1) = 1 + chi(1) = nbas + clo(2) = 1 + chi(2) = nbas + +c transform moment operator + +c UL' MomenT UL, store in g_P + + call nga_matmul_patch('t','n',1d0,0d0, + & g_u(1),clo,chi, + & g_int,alo,ahi, + & g_temp,clo,chi) - call ga_zero(g_P) - call ga_put(g_P,1,nbas,1,nbas, dbl_mb(k_omP), nbas) - -c ----------------------------------------- -c calculate electronic EFG again, this time + call nga_matmul_patch('n','n',1d0,0d0, + & g_temp,clo,chi, + & g_u(1),clo,chi, + & g_P,clo,chi) + +c US' pMomenTp US, add to g_P + + call nga_matmul_patch('t','n',1d0,0d0, + & g_u(2),clo,chi, + & g_w(i),clo,chi, + & g_temp,clo,chi) + + call nga_matmul_patch('n','n',1d0,1d0, + & g_temp,clo,chi, + & g_u(2),clo,chi, + & g_P,clo,chi) + +c call ga_print(g_P) + +c --------------------------------- +c calculate moment again, this time c using the transformed operator -c ----------------------------------------- +c --------------------------------- moment(i) = 0.0d0 - clo(1) = 1 - chi(1) = nbas - clo(2) = 1 - chi(2) = nbas - - alo(1) = 1 ahi(1) = nbas alo(2) = 1 @@ -473,11 +386,6 @@ c -------------------- if (.not. ga_destroy(g_w(j))) call errquit & ('x2c_moment: failed destroying g_w',1+10*j, GA_ERR) end do - - if (.not.ma_chop_stack(l_amP)) call errquit - & ('x2c_moment: ma_chop_stack l_amP failed',911,MA_ERR) - - 8000 continue if (.not. ga_destroy(g_temp)) call errquit & ('x2c_moment: ga corrupt?',12, GA_ERR) @@ -486,11 +394,6 @@ c -------------------- if (.not. ga_destroy(g_int)) call errquit ('x2cefg: ga corrupt?' & ,11, GA_ERR) - -c undo addition of alpha and beta density matrix: - - if (ipol.gt.1) - & call ga_dadd(1.d0, g_dscf(1), -1.d0, g_dscf(2), g_dscf(1)) c -------- c all done diff --git a/src/nwdft/x2c/x2c_getw_moment_scalar.F b/src/nwdft/x2c/x2c_getw_moment_scalar.F index eca7bb5131..8584a5430a 100644 --- a/src/nwdft/x2c/x2c_getw_moment_scalar.F +++ b/src/nwdft/x2c/x2c_getw_moment_scalar.F @@ -56,7 +56,7 @@ c == local variables == logical me c me = (ga_nodeid().eq.0) - dbg=1 + dbg=0 if (dbg>0 .and. me) write (luout,*) 'entering getw_moment' @@ -172,7 +172,7 @@ c == chi == & int_mb(ibas_cent_info), int_mb(ibas_cset_info)) c c calculate integrals - if(me) write (luout,*) 'calling wmoment_sc' + if(dbg>0 .and. me) write (luout,*) 'calling wmoment_sc' call calc_x2c_wmoment_scalar( & ao_bas_han, geom, ipol, g_dens, & dbl_mb(idelchi_ao), @@ -180,7 +180,7 @@ c calculate integrals & nbf_ao, nqpts, ncenters, & origin,type,ncomp, & dbl_mb(ix2c)) ! out - if(me) write (luout,*) 'return from wmoment_sc' + if(dbg>0 .and. me) write (luout,*) 'return wmoment_sc' c == delete memory == diff --git a/src/nwdft/zora/grid_moments.F b/src/nwdft/zora/grid_moments.F index ff01ad8baa..53eaa44212 100644 --- a/src/nwdft/zora/grid_moments.F +++ b/src/nwdft/zora/grid_moments.F @@ -16,7 +16,7 @@ c qxyz , grid points #include "stdio.fh" #include "zora.fh" #include "errquit.fh" - integer igrid,nqpts,ncomp + integer igrid,nqpts,ncomp,dbg integer closegridpts(*) double precision origin(3) double precision qxyz(3,nqpts) @@ -27,8 +27,9 @@ c qxyz , grid points c ================================================================= + dbg = 0 master = (ga_nodeid().eq.0) - if (master) write (luout,*) 'grid_moments: cutoff =', + if (dbg>0 .and. master) write (luout,*) 'grid_moments: cutoff =', & zoracutoff_EFG From 573c40e3f1d5ebc366b4c95f5f8688611cc487bf Mon Sep 17 00:00:00 2001 From: Jochen Autschbach Date: Mon, 28 Mar 2022 19:46:05 -0400 Subject: [PATCH 03/15] added linear equation solver routine to replace ga_solve when scalapack is not available, for the x2c module --- src/nwdft/x2c/ma_solve.F | 128 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 128 insertions(+) create mode 100644 src/nwdft/x2c/ma_solve.F diff --git a/src/nwdft/x2c/ma_solve.F b/src/nwdft/x2c/ma_solve.F new file mode 100644 index 0000000000..aa8bb593b3 --- /dev/null +++ b/src/nwdft/x2c/ma_solve.F @@ -0,0 +1,128 @@ + subroutine ma_solve(g_a, g_bx) + +#include "mafdecls.fh" +#include "global.fh" +#include "rtdb.fh" +#include "util.fh" +#include "stdio.fh" +#include "errquit.fh" + +c purpose: solve linear equation system AX = B with square +c non-symmetric matrix. ga_solve relies on SCALAPACK for reliable +c results, which we may not have available in a given build + +c routine uses 2n**2 words of extra floating point storage, with +c input matrices of dimension n x n + + integer g_a ! inout: coefficient matrix A + integer g_bx ! in: rhs. B. out: solution matrix X + +c local variables + + integer g_x, g_y + + integer l_amat, k_amat + integer l_bmat, k_bmat + integer l_xmat, k_xmat + integer l_ipiv, k_ipiv + integer l_tmp, k_tmp + + integer n, n2, ntmp, inf1, inf2, dbg, type + + logical master + + character*8 pname + +c ================================================================ + + dbg = 0 ! debug setting during code development + + pname = "ma_solve" + + master = ga_nodeid().eq.0 + + if (dbg>0.and.master) write(luout,*) 'entering '//pname + + n = 0 + + call ga_inquire(g_a,type,n,n) + call ga_inquire(g_bx,type,ntmp,ntmp) + + if (ntmp.ne.n) then + call errquit( + & pname//': input ga dimensions do not match',n,GA_ERR) + end if + + if (dbg>0.and.master) write(luout,*) pname//'n = ',n + + n2 = n*n + + info1 = 0 + info2 = 0 + +c allocate MA arrays and retrieve data from GAs + +c amat + if (.not. ma_push_get(mt_dbl, n2, 'amat', l_amat, k_amat)) + & call errquit(pname//': failed allocation amat', n2, MA_ERR) + +c tmp + if (.not. ma_push_get(mt_dbl, n, 'tmp', l_tmp, k_tmp)) + & call errquit(pname//': failed allocation tmp', n, MA_ERR) + +c ipiv + if (.not. ma_push_get(mt_int, n, 'ipiv', l_ipiv, k_ipiv)) + & call errquit(pname//': failed allocation ipiv', n, MA_ERR) + + call dfill(n2, 0.0d0, dbl_mb(k_amat), 1) + call dfill(n, 0.0d0, dbl_mb(k_tmp), 1) + + call ga_get(g_a, 1, n, 1, n, dbl_mb(k_amat), n) + +c invert matrix A and store in temp GA + + call dgetrf(n, n, dbl_mb(k_amat), n, int_mb(k_ipiv), inf1) + call dgetri(n, dbl_mb(k_amat), n, int_mb(k_ipiv), + & dbl_mb(k_tmp), n, inf2) + + if(dbg>0.and.master) + & write(luout,*) pname//': inf1, inf2 = ',inf1, inf2 + +c allocate temp GA and store inverse of A + + if (.not.ga_duplicate(g_a, g_x, 'g_x')) call + & errquit(pname//': ga_dup failed g_x ',101, GA_ERR) + + call ga_put(g_x, 1,n, 1,n, dbl_mb(k_amat), n) + +c MA arrays no longer needed + + if (.not.ma_chop_stack(l_amat)) call + & errquit(pname//': ma_chop_stack failed k_amat',l_tmp,MA_ERR) + +c allocate one more GA, perform X = A**(-1) B, and +c store the result in g_bx + + if (.not.ga_duplicate(g_a, g_y, 'g_y')) call + & errquit(pname//': ga_dup failed g_y ',102, GA_ERR) + + call ga_dgemm('N', 'N', n, n, n, 1.d0, + & g_x, g_bx, 0.0d0, g_y) + + call ga_copy(g_y, g_bx) + +c deallocate GAs + + if (.not. ga_destroy(g_y)) + & call errquit(pname//': error destroy g_y',102, GA_ERR) + + if (.not. ga_destroy(g_x)) + & call errquit(pname//': error destroy g_x',101, GA_ERR) + +c all done. return + + if (dbg>0.and.master) write(luout,*) 'leaving '//pname + + return + + end From d6ec8693e752bcd271cb686eb8e22db7309f1494 Mon Sep 17 00:00:00 2001 From: Jochen Autschbach Date: Mon, 28 Mar 2022 19:50:27 -0400 Subject: [PATCH 04/15] adapted x2c code to use the routine added in commit 4bbe57c680 --- src/nwdft/x2c/GNUmakefile | 3 ++- src/nwdft/x2c/calc_x2c_1e_scalar_ga.F | 14 +++++++++++++- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/src/nwdft/x2c/GNUmakefile b/src/nwdft/x2c/GNUmakefile index 117ccde70a..afc1280044 100644 --- a/src/nwdft/x2c/GNUmakefile +++ b/src/nwdft/x2c/GNUmakefile @@ -11,7 +11,8 @@ calc_x2c_wefg_scalar.o \ calc_x2c_wmoment_scalar.o \ write_x2c_pc_dip.o \ - read_x2c_pc_dip.o + read_x2c_pc_dip.o \ + ma_solve.o LIBRARY = libnwdft.a diff --git a/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F b/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F index 80d3f6f07d..9bcab43488 100644 --- a/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F +++ b/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F @@ -752,12 +752,24 @@ c destroy temp GA and reallocate with nubas**2 elements & errquit(pname//': ga_dup failed g_temp',73,GA_ERR) c solve matrix equation X A = B for X, store in g_h -c that is, solve A' X' = B' (' = Transpose), then transpose +c that is, solve A' X' = B' (' = Transpose), then transpose. +c matrix A is square, but not symmetric. + call ga_transpose(g_m, g_temp) call ga_copy(g_temp, g_m) call ga_transpose(g_h, g_temp) call ga_copy(g_temp, g_h) ! keep copy of B' in g_temp, too + +#ifdef SCALAPACK + if (dbg>0.and.master) write(luout,*) 'calling ga_solve' info = ga_solve(g_m, g_h) ! g_h now has solution X + if (dbg>0.and.master) write(luout,*) 'info from ga_solve:', info +#else + if (dbg>0.and.master) write(luout,*) 'calling ma_solve' + call ma_solve(g_m, g_h) +#endif + +c test quality of the solution: call ga_dgemm('N', 'N', nu, nu, nu, 1.d0, & g_m, g_h, -1.d0, g_temp) ! g_temp = A'X'-B', should be zero call ga_maxelt(g_temp, rtemp) From b65a657e83027ec9835d2fff2441a6f3be03abf3 Mon Sep 17 00:00:00 2001 From: Jochen Autschbach Date: Thu, 27 Jan 2022 15:20:38 -0500 Subject: [PATCH 05/15] fixed zora error in dft_scf.F from x2c development, which showed up in the ch3radical_unrot QA test. --- QA/doafewqmtests.mpi | 1 + src/nwdft/scf_dft/dft_scf.F | 6 +++--- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/QA/doafewqmtests.mpi b/QA/doafewqmtests.mpi index ff42392f4e..a1dae1f5ca 100755 --- a/QA/doafewqmtests.mpi +++ b/QA/doafewqmtests.mpi @@ -28,6 +28,7 @@ fi ./runtests.mpi.unix procs $np tddft_n2+ ./runtests.mpi.unix procs $np tddft_ac_co ./runtests.mpi.unix procs $np hi_zora_sf +./runtests.mpi.unix procs $np ch3radical_unrot # # newproperty tests ./runtests.mpi.unix procs $np prop_ch3f diff --git a/src/nwdft/scf_dft/dft_scf.F b/src/nwdft/scf_dft/dft_scf.F index 7fb6dbe84e..060be29ba0 100644 --- a/src/nwdft/scf_dft/dft_scf.F +++ b/src/nwdft/scf_dft/dft_scf.F @@ -192,7 +192,7 @@ c == zora related == logical dft_zora_read, dft_zora_write, dft_zora_inquire_file external dft_zora_read, dft_zora_write, dft_zora_inquire_file character*255 zorafilename - integer g_zora_sf(2) +c integer g_zora_sf(2) integer g_zora_scale_sf(2) double precision ener_scal integer icalczora @@ -290,7 +290,7 @@ c <-- MN solvation models c c ========================================================================= c - dbg=1 ! debug level during code development. + dbg=0 ! debug level during code development. c k_3cERI = 0 k_3cwhat = 0 @@ -834,7 +834,7 @@ c 11 format('In dft_scf:: zetanuc_arr(',i3,')=',f35.8) dbl_mb(k_zetanuc+iatom-1)=dsqrt(dbl_mb(k_zetanuc+iatom-1)) ! Calc sqrt(zetanuc) enddo ! end-loop-iatom c------- FA-code-added-09-26-11 --------------------------- END - call zora_getv_sf(rtdb, g_dens_at, g_zora_sf,g_zora_scale_sf, + call zora_getv_sf(rtdb, g_dens_at, g_rel,g_zora_scale_sf, & ofinite,dbl_mb(k_zetanuc), & Knucl, nexc) if (.not. MA_free_heap(l_zetanuc)) call errquit From 971ca9fdf415db58711e7e7ff50387f1b13b4bf1 Mon Sep 17 00:00:00 2001 From: Jochen Autschbach Date: Thu, 27 Jan 2022 14:20:55 -0500 Subject: [PATCH 06/15] fix for nt_mpole_1ega --- src/config/make_nwchem_config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/config/make_nwchem_config b/src/config/make_nwchem_config index be97b4d548..91b3a0d96e 100644 --- a/src/config/make_nwchem_config +++ b/src/config/make_nwchem_config @@ -318,7 +318,7 @@ STUBROUTINES := $(patsubst rism,task_rism rism_input,$(STUBROUTINES) ) STUBROUTINES := $(patsubst qmmm, qmmm_input task_qmmm_fep task_qmmm_abc qmmm_print_energy1 qmmm_forces qmmm_init qmmm_end task_qmmm_energy task_qmmm_gradient task_qmmm_optimize task_qmmm_dynamics task_qmmm_esp task_qmmm_pes task_qmmm_thermo qmmm_bq_forces,$(STUBROUTINES) ) STUBROUTINES := $(patsubst mm, mm_add_energy mm_add_egrad mm_input mmi_init mmi_end mm_task_gradient mm_task_energy,$(STUBROUTINES) ) STUBROUTINES := $(patsubst dplot,dplot dplot_input player,$(STUBROUTINES) ) -STUBROUTINES := $(patsubst property,property raman_input task_raman prop_input hnd_nwhnd_tran hnd_prp_vec_read hnd_diag hnd_elfcon_symm hnd_elfcon hnd_elfcon_fde get_slctd_atoms xc_tabcd_giao_nmr_rhs int_giao_1ega fiao_b1_movecs giao_b1_movecs,$(STUBROUTINES) ) +STUBROUTINES := $(patsubst property,property raman_input task_raman prop_input hnd_nwhnd_tran hnd_prp_vec_read hnd_diag hnd_elfcon_symm hnd_elfcon hnd_elfcon_fde get_slctd_atoms xc_tabcd_giao_nmr_rhs int_giao_1ega fiao_b1_movecs giao_b1_movecs int_mpole_1ega,$(STUBROUTINES) ) STUBROUTINES := $(patsubst solvation,cosmo_input cosmo_initialize cosmo_charges cosmo_charges_from_dmat cosmo_def_radii cosmo_tidy cosff cosdff grad_hnd_cos cosmo_smd_output cosmo_vem_output,$(STUBROUTINES) ) STUBROUTINES := $(patsubst vscf,task_vscf vscf_input,$(STUBROUTINES) ) STUBROUTINES := $(patsubst dntmc,task_dntmc dntmc_input,$(STUBROUTINES) ) From 91827084a07f5c3f969a6f6cfda25c737cec2bdf Mon Sep 17 00:00:00 2001 From: Jochen Autschbach Date: Mon, 28 Mar 2022 10:50:45 -0400 Subject: [PATCH 07/15] added test ch3radical_unrot to doafewqmtests.mpi and fixed error in dft_scf.F that caused the test to fail after adding x2c code --- src/nwdft/scf_dft/dft_scf.F | 1 - 1 file changed, 1 deletion(-) diff --git a/src/nwdft/scf_dft/dft_scf.F b/src/nwdft/scf_dft/dft_scf.F index 060be29ba0..0c0c3c76c2 100644 --- a/src/nwdft/scf_dft/dft_scf.F +++ b/src/nwdft/scf_dft/dft_scf.F @@ -192,7 +192,6 @@ c == zora related == logical dft_zora_read, dft_zora_write, dft_zora_inquire_file external dft_zora_read, dft_zora_write, dft_zora_inquire_file character*255 zorafilename -c integer g_zora_sf(2) integer g_zora_scale_sf(2) double precision ener_scal integer icalczora From 44eca95c4f831c9ea91f08f382cd4f81dd14b91a Mon Sep 17 00:00:00 2001 From: Jochen Autschbach Date: Tue, 29 Mar 2022 15:27:59 -0400 Subject: [PATCH 08/15] added H2Se test for x2c --- QA/doafewqmtests.mpi | 3 + QA/tests/x2c-h2se/x2c-h2se.nw | 159 ++ QA/tests/x2c-h2se/x2c-h2se.out | 1981 +++++++++++++++++++++++++ src/nwdft/x2c/calc_x2c_1e_scalar_ga.F | 82 +- 4 files changed, 2185 insertions(+), 40 deletions(-) create mode 100644 QA/tests/x2c-h2se/x2c-h2se.nw create mode 100644 QA/tests/x2c-h2se/x2c-h2se.out diff --git a/QA/doafewqmtests.mpi b/QA/doafewqmtests.mpi index a1dae1f5ca..6285fbd1b7 100755 --- a/QA/doafewqmtests.mpi +++ b/QA/doafewqmtests.mpi @@ -55,3 +55,6 @@ fi ./runtests.mpi.unix procs $np h2o2-response-uhf-damping ./runtests.mpi.unix procs $np h2o2-prop-notrans # +#--- relativity tests +./runtests.mpi.unix procs $np x2c-h2se +# diff --git a/QA/tests/x2c-h2se/x2c-h2se.nw b/QA/tests/x2c-h2se/x2c-h2se.nw new file mode 100644 index 0000000000..b0e8924c13 --- /dev/null +++ b/QA/tests/x2c-h2se/x2c-h2se.nw @@ -0,0 +1,159 @@ +echo +start testjob +title efgjob + +memory total 2000 mb stack 1000 mb + +geometry noautoz units bohr nocenter +symmetry c1 +Se 0.0000 0.0000 0.0564 +H 0.0000 1.0575 -0.9594 +H 0.0000 -1.0575 -0.9594 +end + +BASIS "ao basis" spherical PRINT +# Sapporo-DZP uncontracted +#BASIS SET: (4s,3p) -> [4s,3p] +H S + 13.0107003 1.00000000E+00 +H S + 1.9622571 1.00000000E+00 +H S + 0.4445380 1.00000000E+00 +H S + 0.1219496 1.00000000E+00 +H P + 2.8606730 1.00000000E+00 +H P + 0.8881900 1.00000000E+00 +H P + 0.3037760 1.00000000E+00 +#BASIS SET: (17s,14p,9d) -> [17s,14p,9d] +Se S + 241498.6382409 1.00000000E+00 +Se S + 36223.7408736 1.00000000E+00 +Se S + 8243.4547006 1.00000000E+00 +Se S + 2332.0080828 1.00000000E+00 +Se S + 760.4702669 1.00000000E+00 +Se S + 578.5796313 1.00000000E+00 +Se S + 272.0485848 1.00000000E+00 +Se S + 179.7486759 1.00000000E+00 +Se S + 100.7295011 1.00000000E+00 +Se S + 28.6642790 1.00000000E+00 +Se S + 19.9031660 1.00000000E+00 +Se S + 11.8693555 1.00000000E+00 +Se S + 3.3851284 1.00000000E+00 +Se S + 2.0728541 1.00000000E+00 +Se S + 1.4483918 1.00000000E+00 +Se S + 0.3352235 1.00000000E+00 +Se S + 0.1251479 1.00000000E+00 +Se P + 4987.1768459 1.00000000E+00 +Se P + 1182.1765262 1.00000000E+00 +Se P + 381.9907152 1.00000000E+00 +Se P + 144.3524457 1.00000000E+00 +Se P + 59.8682607 1.00000000E+00 +Se P + 54.3041566 1.00000000E+00 +Se P + 26.1507531 1.00000000E+00 +Se P + 11.1948834 1.00000000E+00 +Se P + 7.9587015 1.00000000E+00 +Se P + 3.3433343 1.00000000E+00 +Se P + 1.3700986 1.00000000E+00 +Se P + 0.5441071 1.00000000E+00 +Se P + 0.2107083 1.00000000E+00 +Se P + 0.0794330 1.00000000E+00 +Se D + 237.0548228 1.00000000E+00 +Se D + 70.8504951 1.00000000E+00 +Se D + 26.4912435 1.00000000E+00 +Se D + 10.9539115 1.00000000E+00 +Se D + 4.6411645 1.00000000E+00 +Se D + 1.9254421 1.00000000E+00 +Se D + 0.7322816 1.00000000E+00 +Se D + 0.5653420 1.00000000E+00 +Se D + 0.2082120 1.00000000E+00 +End + +charge 0 + +relativistic +x2c on +#zora on +#douglas-kroll on +zora:cutoff_EFG 1d-10 +zora:cutoff 1d-30 +#clight 1e6 +clight 137.0359895 +end + +set lindep:n_dep 0 + +# set dft:no_prune T +set dft:tol_rho 1d-30 +set int:cando_txs f +set dft:job_grid_acc 1d-20 + +dft +grid xfine +direct +#xc slater 1.0 becke88 nonlocal 1.0 lyp 1.0 +xc hfexch +convergence energy 1d-10 +iterations 50 +#print "quadrature" +end + +set lindep:n_dep 0 + + +#set sodft:scalar true + +#set sodft:spinprojection 0. 0. 1. +#set sodft:collinear true +#set sodft:bfield 0. 1e-4 0. +#set sodft:xcallinone T +#set sodft:alternativexc T +set sodft:debugenergy T +#set sodft:x2c T +set x2c:analyticpvp T +#set x2c:efg T + +task dft + diff --git a/QA/tests/x2c-h2se/x2c-h2se.out b/QA/tests/x2c-h2se/x2c-h2se.out new file mode 100644 index 0000000000..70d0412dd8 --- /dev/null +++ b/QA/tests/x2c-h2se/x2c-h2se.out @@ -0,0 +1,1981 @@ +running on 8 processors + argument 1 = h2se.nw + + + +============================== echo of input deck ============================== +echo +start testjob +title efgjob + +memory total 2000 mb stack 1000 mb + +geometry noautoz units bohr nocenter +symmetry c1 +Se 0.0000 0.0000 0.0564 +H 0.0000 1.0575 -0.9594 +H 0.0000 -1.0575 -0.9594 +end + +BASIS "ao basis" spherical PRINT +# Sapporo-DZP uncontracted +#BASIS SET: (4s,3p) -> [4s,3p] +H S + 13.0107003 1.00000000E+00 +H S + 1.9622571 1.00000000E+00 +H S + 0.4445380 1.00000000E+00 +H S + 0.1219496 1.00000000E+00 +H P + 2.8606730 1.00000000E+00 +H P + 0.8881900 1.00000000E+00 +H P + 0.3037760 1.00000000E+00 +#BASIS SET: (17s,14p,9d) -> [17s,14p,9d] +Se S + 241498.6382409 1.00000000E+00 +Se S + 36223.7408736 1.00000000E+00 +Se S + 8243.4547006 1.00000000E+00 +Se S + 2332.0080828 1.00000000E+00 +Se S + 760.4702669 1.00000000E+00 +Se S + 578.5796313 1.00000000E+00 +Se S + 272.0485848 1.00000000E+00 +Se S + 179.7486759 1.00000000E+00 +Se S + 100.7295011 1.00000000E+00 +Se S + 28.6642790 1.00000000E+00 +Se S + 19.9031660 1.00000000E+00 +Se S + 11.8693555 1.00000000E+00 +Se S + 3.3851284 1.00000000E+00 +Se S + 2.0728541 1.00000000E+00 +Se S + 1.4483918 1.00000000E+00 +Se S + 0.3352235 1.00000000E+00 +Se S + 0.1251479 1.00000000E+00 +Se P + 4987.1768459 1.00000000E+00 +Se P + 1182.1765262 1.00000000E+00 +Se P + 381.9907152 1.00000000E+00 +Se P + 144.3524457 1.00000000E+00 +Se P + 59.8682607 1.00000000E+00 +Se P + 54.3041566 1.00000000E+00 +Se P + 26.1507531 1.00000000E+00 +Se P + 11.1948834 1.00000000E+00 +Se P + 7.9587015 1.00000000E+00 +Se P + 3.3433343 1.00000000E+00 +Se P + 1.3700986 1.00000000E+00 +Se P + 0.5441071 1.00000000E+00 +Se P + 0.2107083 1.00000000E+00 +Se P + 0.0794330 1.00000000E+00 +Se D + 237.0548228 1.00000000E+00 +Se D + 70.8504951 1.00000000E+00 +Se D + 26.4912435 1.00000000E+00 +Se D + 10.9539115 1.00000000E+00 +Se D + 4.6411645 1.00000000E+00 +Se D + 1.9254421 1.00000000E+00 +Se D + 0.7322816 1.00000000E+00 +Se D + 0.5653420 1.00000000E+00 +Se D + 0.2082120 1.00000000E+00 +End + +charge 0 + +relativistic +x2c on +#zora on +#douglas-kroll on +zora:cutoff_EFG 1d-10 +zora:cutoff 1d-30 +#clight 1e6 +clight 137.0359895 +end + +set lindep:n_dep 0 + +# set dft:no_prune T +set dft:tol_rho 1d-30 +set int:cando_txs f +set dft:job_grid_acc 1d-20 + +dft +grid xfine +direct +#xc slater 1.0 becke88 nonlocal 1.0 lyp 1.0 +xc hfexch +convergence energy 1d-10 +iterations 50 +#print "quadrature" +end + +set lindep:n_dep 0 + + +#set sodft:scalar true + +#set sodft:spinprojection 0. 0. 1. +#set sodft:collinear true +#set sodft:bfield 0. 1e-4 0. +#set sodft:xcallinone T +#set sodft:alternativexc T +set sodft:debugenergy T +#set sodft:x2c T +set x2c:analyticpvp T +#set x2c:efg T + +task dft + +================================================================================ + + + + + + + Northwest Computational Chemistry Package (NWChem) 7.0.1 + -------------------------------------------------------- + + + Environmental Molecular Sciences Laboratory + Pacific Northwest National Laboratory + Richland, WA 99352 + + Copyright (c) 1994-2020 + Pacific Northwest National Laboratory + Battelle Memorial Institute + + NWChem is an open-source computational chemistry package + distributed under the terms of the + Educational Community License (ECL) 2.0 + A copy of the license is included with this distribution + in the LICENSE.TXT file + + ACKNOWLEDGMENT + -------------- + + This software and its documentation were developed at the + EMSL at Pacific Northwest National Laboratory, a multiprogram + national laboratory, operated for the U.S. Department of Energy + by Battelle under Contract Number DE-AC05-76RL01830. Support + for this work was provided by the Department of Energy Office + of Biological and Environmental Research, Office of Basic + Energy Sciences, and the Office of Advanced Scientific Computing. + + + Job information + --------------- + + hostname = ja31 + program = /home/workspace/jochena/nwchem/github-own/bin/LINUX64/nwchem + date = Tue Mar 29 15:25:05 2022 + + compiled = Tue_Mar_29_15:24:31_2022 + source = /home/workspace/jochena/nwchem/github-own + nwchem branch = 7.0.0 + nwchem revision = nwchem_on_git-3781-g48a39837f5 + ga revision = 5.8.1 + use scalapack = T + input = h2se.nw + prefix = testjob. + data base = ./testjob.db + status = startup + nproc = 8 + time left = -1s + + + + Memory information + ------------------ + + heap = 43690666 doubles = 333.3 Mbytes + stack = 131071999 doubles = 1000.0 Mbytes + global = 87381333 doubles = 666.7 Mbytes (distinct from heap & stack) + total = 262143998 doubles = 2000.0 Mbytes + verify = yes + hardfail = no + + + Directory information + --------------------- + + 0 permanent = . + 0 scratch = /tmp + + + + + NWChem Input Module + ------------------- + + + efgjob + ------ + Turning off AUTOSYM since + SYMMETRY directive was detected! + + + + Geometry "geometry" -> "" + ------------------------- + + Output coordinates in a.u. (scale by 1.000000000 to convert to a.u.) + + No. Tag Charge X Y Z + ---- ---------------- ---------- -------------- -------------- -------------- + 1 Se 34.0000 0.00000000 0.00000000 0.05640000 + 2 H 1.0000 0.00000000 1.05750000 -0.95940000 + 3 H 1.0000 0.00000000 -1.05750000 -0.95940000 + + Atomic Mass + ----------- + + Se 78.918300 + H 1.007825 + + + Effective nuclear repulsion energy (a.u.) 46.8467471364 + + Nuclear Dipole moment (a.u.) + ---------------------------- + X Y Z + ---------------- ---------------- ---------------- + 0.0000000000 0.0000000000 -0.0012000000 + + + XYZ format geometry + ------------------- + 3 + geometry + Se 0.00000000 0.00000000 0.02984560 + H 0.00000000 0.55960494 -0.50769265 + H 0.00000000 -0.55960494 -0.50769265 + + ============================================================================== + internuclear distances + ------------------------------------------------------------------------------ + center one | center two | atomic units | a.u. + ------------------------------------------------------------------------------ + 2 H | 1 Se | 1.46634 | 1.46634 + 3 H | 1 Se | 1.46634 | 1.46634 + ------------------------------------------------------------------------------ + number of included internuclear distances: 2 + ============================================================================== + + + + ============================================================================== + internuclear angles + ------------------------------------------------------------------------------ + center 1 | center 2 | center 3 | degrees + ------------------------------------------------------------------------------ + 2 H | 1 Se | 3 H | 92.30 + ------------------------------------------------------------------------------ + number of included internuclear angles: 1 + ============================================================================== + + + + library name resolved from: environment + library file name is: < + /home/workspace/jochena/nwchem/github-own/src/basis/libraries/> + + Basis "ao basis" -> "" (spherical) + ----- + H (Hydrogen) + ------------ + Exponent Coefficients + -------------- --------------------------------------------------------- + 1 S 1.30107003E+01 1.000000 + + 2 S 1.96225710E+00 1.000000 + + 3 S 4.44538000E-01 1.000000 + + 4 S 1.21949600E-01 1.000000 + + 5 P 2.86067300E+00 1.000000 + + 6 P 8.88190000E-01 1.000000 + + 7 P 3.03776000E-01 1.000000 + + Se (Selenium) + ------------- + Exponent Coefficients + -------------- --------------------------------------------------------- + 1 S 2.41498638E+05 1.000000 + + 2 S 3.62237409E+04 1.000000 + + 3 S 8.24345470E+03 1.000000 + + 4 S 2.33200808E+03 1.000000 + + 5 S 7.60470267E+02 1.000000 + + 6 S 5.78579631E+02 1.000000 + + 7 S 2.72048585E+02 1.000000 + + 8 S 1.79748676E+02 1.000000 + + 9 S 1.00729501E+02 1.000000 + + 10 S 2.86642790E+01 1.000000 + + 11 S 1.99031660E+01 1.000000 + + 12 S 1.18693555E+01 1.000000 + + 13 S 3.38512840E+00 1.000000 + + 14 S 2.07285410E+00 1.000000 + + 15 S 1.44839180E+00 1.000000 + + 16 S 3.35223500E-01 1.000000 + + 17 S 1.25147900E-01 1.000000 + + 18 P 4.98717685E+03 1.000000 + + 19 P 1.18217653E+03 1.000000 + + 20 P 3.81990715E+02 1.000000 + + 21 P 1.44352446E+02 1.000000 + + 22 P 5.98682607E+01 1.000000 + + 23 P 5.43041566E+01 1.000000 + + 24 P 2.61507531E+01 1.000000 + + 25 P 1.11948834E+01 1.000000 + + 26 P 7.95870150E+00 1.000000 + + 27 P 3.34333430E+00 1.000000 + + 28 P 1.37009860E+00 1.000000 + + 29 P 5.44107100E-01 1.000000 + + 30 P 2.10708300E-01 1.000000 + + 31 P 7.94330000E-02 1.000000 + + 32 D 2.37054823E+02 1.000000 + + 33 D 7.08504951E+01 1.000000 + + 34 D 2.64912435E+01 1.000000 + + 35 D 1.09539115E+01 1.000000 + + 36 D 4.64116450E+00 1.000000 + + 37 D 1.92544210E+00 1.000000 + + 38 D 7.32281600E-01 1.000000 + + 39 D 5.65342000E-01 1.000000 + + 40 D 2.08212000E-01 1.000000 + + + + Summary of "ao basis" -> "" (spherical) + ------------------------------------------------------------------------------ + Tag Description Shells Functions and Types + ---------------- ------------------------------ ------ --------------------- + H user specified 7 13 4s3p + Se user specified 40 104 17s14p9d + + + +The speed of light used in the relativistic calculations is 0.1370360E+03au. + + xc_inp: hfexch multiplicative factor not found. + + NWChem DFT Module + ----------------- + + + efgjob + + + + + Summary of "ao basis" -> "ao basis" (spherical) + ------------------------------------------------------------------------------ + Tag Description Shells Functions and Types + ---------------- ------------------------------ ------ --------------------- + H user specified 7 13 4s3p + Se user specified 40 104 17s14p9d + + + int_init: cando_txs set to always be F + Caching 1-el integrals + itol2e modified to match energy + convergence criterion. + + General Information + ------------------- + SCF calculation type: DFT + Wavefunction type: closed shell. + No. of atoms : 3 + No. of electrons : 36 + Alpha electrons : 18 + Beta electrons : 18 + Charge : 0 + Spin multiplicity: 1 + Use of symmetry is: off; symmetry adaption is: off + Maximum number of iterations: 50 + This is a Direct SCF calculation. + AO basis - number of functions: 130 + number of shells: 54 + Convergence on energy requested: 1.00D-10 + Convergence on density requested: 1.00D-05 + Convergence on gradient requested: 5.00D-04 + + XC Information + -------------- + Hartree-Fock (Exact) Exchange 1.000 + + Convergence Information + ----------------------- + Convergence aids based upon iterative change in + total energy or number of iterations. + Levelshifting, if invoked, occurs when the + HOMO/LUMO gap drops below (HL_TOL): 1.00D-02 + DIIS, if invoked, will attempt to extrapolate + using up to (NFOCK): 10 stored Fock matrices. + + Damping( 0%) Levelshifting(0.5) DIIS + --------------- ------------------- --------------- + dE on: start ASAP start + dE off: 2 iters 50 iters 50 iters + + + Screening Tolerance Information + ------------------------------- + Density screening/tol_rho: 1.00D-30 + AO Gaussian exp screening on grid/accAOfunc: 23 + CD Gaussian exp screening on grid/accCDfunc: 20 + XC Gaussian exp screening on grid/accXCfunc: 20 + Schwarz screening/accCoul: 1.00D-11 + + dft: using X2C + + Superposition of Atomic Density Guess + ------------------------------------- + + Sum of atomic energies: -2400.80916852 + allocating g_x2c 130 + calling calc_x2c_1e_scalar + entering x2c_1e_scalar + x2c_1e_scalar: nu, nc = 130 130 + x2c INFO: Assuming that the AO basis is fully uncontracted + x2c_1e_scalar: T,V,S done + g_densu, g_dens(1) = -993 -993 + x2c_1e_scalar: debug S: + x2c_1e_scalar: tr(P * S) : 0.3600000E+02 + x2c_1e_scalar: debug T: + x2c_1e_scalar: tr(P * T) : 0.2400634E+04 + x2c_1e_scalar: debug V: + x2c_1e_scalar: tr(P * V) : -0.5830261E+04 + x2c_1e_scalar: 1e energy : -0.3429627E+04 + x2c_1e_scalar: calculating analytic p.Vp integrals + x2c_1e_scalar: skipping numerical W integrals + calling ga_diag + calling ma_solve + largest element in A'X'-B': 4.813927034774679E-013 + leaving x2c_1e_scalar + + Forcing the number of linearly dependent vectors to be 0 + + Superposition of Atomic Density Guess + ------------------------------------- + + Sum of atomic energies: -2400.80916852 + + Non-variational initial energy + ------------------------------ + + Total energy = -2402.169554 + 1-e energy = -3429.626958 + 2-e energy = 980.610657 + HOMO = -0.372787 + LUMO = 0.137600 + + Time after variat. SCF: 0.9 + Time prior to 1st pass: 0.9 + + Memory utilization after 1st SCF pass: + Heap Space remaining (MW): 43.69 43689346 + Stack Space remaining (MW): 131.07 131071180 + + convergence iter energy DeltaE RMS-Dens Diis-err time + ---------------- ----- ----------------- --------- --------- --------- ------ + d= 0,ls=0.0,diis 1 -2421.3969694110 -2.47D+03 4.02D-03 3.72D+05 1.6 + d= 0,ls=0.0,diis 2 -2427.6812208550 -6.28D+00 1.12D-03 3.36D+00 2.2 + d= 0,ls=0.0,diis 3 -2427.6901508037 -8.93D-03 7.13D-04 4.38D-01 2.8 + d= 0,ls=0.0,diis 4 -2427.6958611175 -5.71D-03 2.06D-04 3.53D-02 3.6 + d= 0,ls=0.0,diis 5 -2427.6964931157 -6.32D-04 7.23D-05 8.11D-05 4.3 + Resetting Diis + d= 0,ls=0.0,diis 6 -2427.6965058454 -1.27D-05 2.86D-05 4.54D-06 5.0 + d= 0,ls=0.0,diis 7 -2427.6965071485 -1.30D-06 2.27D-06 4.56D-08 5.8 + d= 0,ls=0.0,diis 8 -2427.6965071597 -1.12D-08 1.37D-06 7.21D-09 6.5 + d= 0,ls=0.0,diis 9 -2427.6965071618 -2.04D-09 2.87D-07 1.44D-09 7.2 + d= 0,ls=0.0,diis 10 -2427.6965071619 -1.43D-10 1.18D-07 8.42D-11 8.0 + d= 0,ls=0.0,diis 11 -2427.6965071619 -9.55D-12 2.57D-08 3.21D-12 8.7 + + + Total DFT energy = -2427.696507161947 + One electron energy = -3469.058562893229 + Coulomb energy = 1082.665174093308 + Exchange-Corr. energy = -88.149865498388 + Nuclear repulsion energy = 46.846747136363 + + Numeric. integr. density = 0.000000000000 + + Total iterative time = 7.8s + + + + DFT Final Molecular Orbital Analysis + ------------------------------------ + + Vector 1 Occ=2.000000D+00 E=-4.680334D+02 + MO Center= -1.6D-18, -3.7D-18, 3.0D-02, r^2= 7.2D-04 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 7 0.415947 1 Se s 5 0.265356 1 Se s + 9 0.246577 1 Se s 4 0.108624 1 Se s + 8 0.045323 1 Se s 3 0.033760 1 Se s + + Vector 2 Occ=2.000000D+00 E=-6.234711D+01 + MO Center= -1.2D-14, 6.0D-15, 3.0D-02, r^2= 1.3D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 10 0.629405 1 Se s 12 0.471171 1 Se s + 7 -0.142819 1 Se s 8 -0.137550 1 Se s + 5 -0.087133 1 Se s 9 -0.060587 1 Se s + 4 -0.038073 1 Se s 6 -0.036154 1 Se s + 13 0.026195 1 Se s + + Vector 3 Occ=2.000000D+00 E=-5.466271D+01 + MO Center= -1.2D-17, 1.3D-15, 3.0D-02, r^2= 1.0D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 37 0.425478 1 Se py 31 0.352836 1 Se py + 40 0.193454 1 Se py 28 0.161184 1 Se py + 25 0.048693 1 Se py + + Vector 4 Occ=2.000000D+00 E=-5.466202D+01 + MO Center= 1.5D-13, -6.2D-15, 3.0D-02, r^2= 1.0D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 38 0.425531 1 Se pz 32 0.352957 1 Se pz + 41 0.193302 1 Se pz 29 0.161181 1 Se pz + 26 0.048694 1 Se pz + + Vector 5 Occ=2.000000D+00 E=-5.465902D+01 + MO Center= -1.4D-13, 1.0D-17, 3.0D-02, r^2= 1.0D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 36 0.425752 1 Se px 30 0.353416 1 Se px + 39 0.192761 1 Se px 27 0.161166 1 Se px + 24 0.048697 1 Se px + + Vector 6 Occ=2.000000D+00 E=-9.270976D+00 + MO Center= -1.9D-15, -2.1D-14, 2.0D-02, r^2= 1.1D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 13 0.870209 1 Se s 15 0.458518 1 Se s + 10 -0.317162 1 Se s 11 -0.236364 1 Se s + 12 -0.229605 1 Se s 14 -0.084568 1 Se s + 8 0.078056 1 Se s 7 0.047577 1 Se s + 5 0.032114 1 Se s + + Vector 7 Occ=2.000000D+00 E=-6.802535D+00 + MO Center= 8.1D-16, 8.5D-14, 2.4D-02, r^2= 1.1D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 46 0.587763 1 Se py 43 0.336194 1 Se py + 49 0.260984 1 Se py 37 -0.169806 1 Se py + 31 -0.112122 1 Se py 40 -0.072484 1 Se py + 28 -0.069614 1 Se py 34 -0.055282 1 Se py + + Vector 8 Occ=2.000000D+00 E=-6.794232D+00 + MO Center= -1.5D-13, -7.0D-14, 3.4D-02, r^2= 1.1D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 47 0.588352 1 Se pz 44 0.336108 1 Se pz + 50 0.259821 1 Se pz 38 -0.169915 1 Se pz + 32 -0.112283 1 Se pz 41 -0.072280 1 Se pz + 29 -0.069631 1 Se pz 35 -0.055150 1 Se pz + 13 0.033863 1 Se s + + Vector 9 Occ=2.000000D+00 E=-6.751616D+00 + MO Center= 1.5D-13, 1.8D-16, 2.7D-02, r^2= 1.1D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 45 0.591024 1 Se px 42 0.338638 1 Se px + 48 0.257057 1 Se px 36 -0.170396 1 Se px + 30 -0.112321 1 Se px 39 -0.073170 1 Se px + 27 -0.069922 1 Se px 33 -0.055863 1 Se px + + Vector 10 Occ=2.000000D+00 E=-2.709301D+00 + MO Center= -1.2D-15, 2.6D-16, 1.7D-02, r^2= 1.5D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 81 0.391548 1 Se d -1 86 0.342131 1 Se d -1 + 76 0.271265 1 Se d -1 71 0.113834 1 Se d -1 + 91 0.108971 1 Se d -1 106 -0.047300 2 H s + 119 0.047300 3 H s 107 -0.038116 2 H s + 120 0.038116 3 H s 66 0.028761 1 Se d -1 + + Vector 11 Occ=2.000000D+00 E=-2.656884D+00 + MO Center= 1.5D-15, 8.0D-15, 2.8D-02, r^2= 1.4D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 82 0.287613 1 Se d 0 84 0.277661 1 Se d 2 + 87 0.249907 1 Se d 0 89 0.239765 1 Se d 2 + 77 0.200351 1 Se d 0 79 0.192705 1 Se d 2 + 92 0.104943 1 Se d 0 94 0.092128 1 Se d 2 + 72 0.083846 1 Se d 0 74 0.080820 1 Se d 2 + + Vector 12 Occ=2.000000D+00 E=-2.643653D+00 + MO Center= 4.2D-15, -5.8D-15, 2.5D-02, r^2= 1.4D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 84 -0.286751 1 Se d 2 82 0.277843 1 Se d 0 + 89 -0.245739 1 Se d 2 87 0.238705 1 Se d 0 + 79 -0.198896 1 Se d 2 77 0.193002 1 Se d 0 + 92 0.094086 1 Se d 0 94 -0.090232 1 Se d 2 + 74 -0.083475 1 Se d 2 72 0.080932 1 Se d 0 + + Vector 13 Occ=2.000000D+00 E=-2.634929D+00 + MO Center= -3.1D-15, -7.9D-16, 2.9D-02, r^2= 1.4D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 80 0.401762 1 Se d -2 85 0.345294 1 Se d -2 + 75 0.279302 1 Se d -2 90 0.137806 1 Se d -2 + 70 0.117068 1 Se d -2 65 0.029598 1 Se d -2 + + Vector 14 Occ=2.000000D+00 E=-2.631187D+00 + MO Center= -1.5D-15, -1.8D-15, 3.1D-02, r^2= 1.4D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 83 0.401974 1 Se d 1 88 0.344976 1 Se d 1 + 78 0.279426 1 Se d 1 93 0.137531 1 Se d 1 + 73 0.117135 1 Se d 1 68 0.029613 1 Se d 1 + + Vector 15 Occ=2.000000D+00 E=-1.196687D+00 + MO Center= -3.9D-14, -2.5D-13, -3.5D-01, r^2= 7.7D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 16 0.466182 1 Se s 13 -0.308840 1 Se s + 107 0.247926 2 H s 120 0.247926 3 H s + 14 -0.238111 1 Se s 106 0.118311 2 H s + 119 0.118311 3 H s 47 0.104764 1 Se pz + 11 0.098622 1 Se s 10 0.087389 1 Se s + + Vector 16 Occ=2.000000D+00 E=-6.815117D-01 + MO Center= 1.7D-14, 1.4D-13, -2.7D-01, r^2= 1.1D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 107 0.370926 2 H s 120 -0.370926 3 H s + 52 0.256805 1 Se py 46 -0.226912 1 Se py + 108 0.204886 2 H s 121 -0.204886 3 H s + 55 0.203365 1 Se py 106 0.131770 2 H s + 119 -0.131770 3 H s 43 -0.104971 1 Se py + + Vector 17 Occ=2.000000D+00 E=-4.946048D-01 + MO Center= -1.4D-13, 2.5D-13, 4.0D-01, r^2= 1.3D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 16 0.383340 1 Se s 17 0.378330 1 Se s + 56 0.368116 1 Se pz 53 0.295343 1 Se pz + 47 -0.201711 1 Se pz 107 -0.171053 2 H s + 120 -0.171053 3 H s 59 0.151493 1 Se pz + 13 -0.114278 1 Se s 44 -0.093726 1 Se pz + + Vector 18 Occ=2.000000D+00 E=-3.815819D-01 + MO Center= 1.6D-13, -3.9D-14, -3.5D-02, r^2= 1.7D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 54 0.490706 1 Se px 51 0.348108 1 Se px + 57 0.264019 1 Se px 45 -0.202170 1 Se px + 42 -0.092498 1 Se px 48 -0.060179 1 Se px + 36 0.043057 1 Se px 115 0.030335 2 H px + 128 0.030335 3 H px 30 0.029482 1 Se px + + Vector 19 Occ=0.000000D+00 E= 1.690231D-01 + MO Center= 2.7D-14, 2.8D-11, 6.8D-01, r^2= 5.9D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 108 2.910725 2 H s 121 -2.910725 3 H s + 58 -2.435010 1 Se py 96 -0.335684 1 Se d -1 + 101 0.295543 1 Se d -1 107 0.264355 2 H s + 120 -0.264355 3 H s 91 0.255224 1 Se d -1 + 55 -0.215335 1 Se py 52 -0.082114 1 Se py + + Vector 20 Occ=0.000000D+00 E= 1.899057D-01 + MO Center= 3.3D-13, -3.6D-11, -3.4D-01, r^2= 5.4D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 17 7.626691 1 Se s 108 -4.619589 2 H s + 121 -4.619589 3 H s 16 2.062963 1 Se s + 59 -1.594932 1 Se pz 56 -1.451238 1 Se pz + 107 -0.887824 2 H s 120 -0.887824 3 H s + 116 0.439474 2 H py 129 -0.439474 3 H py + + Vector 21 Occ=0.000000D+00 E= 2.172408D-01 + MO Center= -1.2D-13, 1.4D-13, 3.3D-01, r^2= 6.4D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 17 2.660056 1 Se s 59 -2.003469 1 Se pz + 16 -1.386706 1 Se s 108 -1.160032 2 H s + 121 -1.160032 3 H s 56 0.736387 1 Se pz + 14 -0.627412 1 Se s 15 0.565404 1 Se s + 107 0.345306 2 H s 120 0.345306 3 H s + + Vector 22 Occ=0.000000D+00 E= 2.755836D-01 + MO Center= -1.3D-13, 3.3D-14, 5.6D-02, r^2= 6.0D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 57 1.539524 1 Se px 54 -1.357387 1 Se px + 45 0.184422 1 Se px 51 0.113419 1 Se px + 48 -0.103144 1 Se px 103 -0.088048 1 Se d 1 + 115 0.055355 2 H px 128 0.055355 3 H px + 30 -0.052781 1 Se px 39 0.050854 1 Se px + + Vector 23 Occ=0.000000D+00 E= 2.995167D-01 + MO Center= -2.6D-14, 7.6D-12, -8.2D-01, r^2= 4.1D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 108 4.533203 2 H s 121 -4.533203 3 H s + 55 -2.303622 1 Se py 107 1.143976 2 H s + 120 -1.143976 3 H s 58 -0.827660 1 Se py + 96 0.679403 1 Se d -1 116 -0.514283 2 H py + 129 -0.514283 3 H py 52 -0.508588 1 Se py + + Vector 24 Occ=0.000000D+00 E= 3.956653D-01 + MO Center= -3.5D-14, 3.2D-14, -2.5D-02, r^2= 2.6D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 17 1.560316 1 Se s 104 0.938823 1 Se d 2 + 56 -0.846181 1 Se pz 99 -0.647000 1 Se d 2 + 102 0.595141 1 Se d 0 94 0.565439 1 Se d 2 + 108 -0.517369 2 H s 121 -0.517369 3 H s + 16 -0.296225 1 Se s 107 -0.291708 2 H s + + Vector 25 Occ=0.000000D+00 E= 4.177548D-01 + MO Center= -2.3D-14, -1.2D-13, 8.9D-02, r^2= 2.6D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 102 1.085588 1 Se d 0 17 -0.970223 1 Se s + 97 -0.722470 1 Se d 0 92 0.621590 1 Se d 0 + 56 0.439441 1 Se pz 108 0.305056 2 H s + 121 0.305056 3 H s 104 -0.272702 1 Se d 2 + 99 0.253899 1 Se d 2 94 -0.236687 1 Se d 2 + + Vector 26 Occ=0.000000D+00 E= 4.221146D-01 + MO Center= -2.3D-13, 4.5D-13, 2.5D-02, r^2= 2.5D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 100 1.160562 1 Se d -2 95 -0.762558 1 Se d -2 + 90 0.665269 1 Se d -2 85 -0.119581 1 Se d -2 + 75 -0.057355 1 Se d -2 80 -0.049134 1 Se d -2 + 112 0.043786 2 H px 125 -0.043786 3 H px + 115 -0.030743 2 H px 128 0.030743 3 H px + + Vector 27 Occ=0.000000D+00 E= 4.268975D-01 + MO Center= -3.7D-14, -4.5D-13, 6.7D-02, r^2= 2.6D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 103 1.199832 1 Se d 1 98 -0.754378 1 Se d 1 + 93 0.658238 1 Se d 1 88 -0.118052 1 Se d 1 + 57 0.088414 1 Se px 115 -0.087508 2 H px + 128 -0.087508 3 H px 78 -0.056183 1 Se d 1 + 83 -0.047575 1 Se d 1 112 0.045111 2 H px + + Vector 28 Occ=0.000000D+00 E= 5.190168D-01 + MO Center= 2.3D-13, 7.9D-13, 2.7D-01, r^2= 4.4D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 108 6.173261 2 H s 121 -6.173261 3 H s + 58 -2.809415 1 Se py 101 1.451802 1 Se d -1 + 55 -1.030773 1 Se py 91 0.534252 1 Se d -1 + 96 -0.477618 1 Se d -1 117 0.388386 2 H pz + 130 -0.388386 3 H pz 107 0.352204 2 H s + + Vector 29 Occ=0.000000D+00 E= 7.679420D-01 + MO Center= -1.3D-13, -1.2D-12, 1.4D-01, r^2= 3.9D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 17 13.874985 1 Se s 108 -6.157995 2 H s + 121 -6.157995 3 H s 56 -2.365007 1 Se pz + 59 -2.180038 1 Se pz 16 -1.490699 1 Se s + 107 -1.377902 2 H s 120 -1.377902 3 H s + 15 1.346090 1 Se s 14 -1.258469 1 Se s + + Vector 30 Occ=0.000000D+00 E= 8.749452D-01 + MO Center= -1.5D-14, 7.6D-13, -3.8D-01, r^2= 2.9D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 16 3.805432 1 Se s 17 2.711178 1 Se s + 116 2.031199 2 H py 129 -2.031199 3 H py + 108 -1.920202 2 H s 121 -1.920202 3 H s + 56 -1.854306 1 Se pz 104 1.131340 1 Se d 2 + 107 -1.103102 2 H s 120 -1.103102 3 H s + + Vector 31 Occ=0.000000D+00 E= 8.831226D-01 + MO Center= 5.2D-15, -3.2D-12, -3.4D-02, r^2= 2.8D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 101 1.930709 1 Se d -1 117 -1.707250 2 H pz + 130 1.707250 3 H pz 96 -1.190367 1 Se d -1 + 91 0.950556 1 Se d -1 116 0.737924 2 H py + 129 0.737924 3 H py 52 0.410436 1 Se py + 58 -0.342218 1 Se py 55 -0.288890 1 Se py + + Vector 32 Occ=0.000000D+00 E= 9.498025D-01 + MO Center= -3.2D-14, 2.3D-12, -2.7D-01, r^2= 2.6D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 115 2.069637 2 H px 128 -2.069637 3 H px + 100 -1.640675 1 Se d -2 112 -0.153884 2 H px + 125 0.153884 3 H px 90 0.119317 1 Se d -2 + 95 -0.102613 1 Se d -2 109 0.039141 2 H px + 122 -0.039141 3 H px + + Vector 33 Occ=0.000000D+00 E= 9.841964D-01 + MO Center= 2.6D-14, -2.4D-12, -3.1D-01, r^2= 2.7D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 54 3.958874 1 Se px 115 -2.474379 2 H px + 128 -2.474379 3 H px 103 1.856753 1 Se d 1 + 57 -0.370045 1 Se px 51 -0.181128 1 Se px + 112 0.178524 2 H px 125 0.178524 3 H px + 93 -0.162944 1 Se d 1 98 0.143851 1 Se d 1 + + Vector 34 Occ=0.000000D+00 E= 9.951332D-01 + MO Center= -2.2D-14, -1.5D-12, -4.2D-01, r^2= 3.0D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 16 7.208370 1 Se s 117 -2.903596 2 H pz + 130 -2.903596 3 H pz 102 -2.129369 1 Se d 0 + 107 -2.092352 2 H s 120 -2.092352 3 H s + 15 -1.675838 1 Se s 14 1.654305 1 Se s + 56 1.070493 1 Se pz 53 -0.906414 1 Se pz + + Vector 35 Occ=0.000000D+00 E= 1.040337D+00 + MO Center= -3.5D-15, -3.1D-11, -5.7D-01, r^2= 2.7D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 116 3.018724 2 H py 129 3.018724 3 H py + 108 -2.267077 2 H s 121 2.267078 3 H s + 107 -1.543428 2 H s 120 1.543428 3 H s + 96 -1.274034 1 Se d -1 55 -1.066328 1 Se py + 101 0.872384 1 Se d -1 52 0.731271 1 Se py + + Vector 36 Occ=0.000000D+00 E= 1.043813D+00 + MO Center= 2.2D-14, 2.6D-11, -1.0D-01, r^2= 2.7D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 56 -5.653918 1 Se pz 16 5.295061 1 Se s + 17 4.284091 1 Se s 107 -4.227368 2 H s + 120 -4.227368 3 H s 108 -1.762025 2 H s + 121 -1.762025 3 H s 102 1.727587 1 Se d 0 + 15 -1.334062 1 Se s 14 1.165994 1 Se s + + Vector 37 Occ=0.000000D+00 E= 1.062429D+00 + MO Center= 2.0D-15, 1.0D-11, -6.1D-01, r^2= 2.9D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 55 6.539579 1 Se py 108 -5.078268 2 H s + 121 5.078268 3 H s 107 -4.547819 2 H s + 120 4.547819 3 H s 101 -2.051283 1 Se d -1 + 96 -1.537194 1 Se d -1 117 -1.419859 2 H pz + 130 1.419859 3 H pz 58 0.829089 1 Se py + + Vector 38 Occ=0.000000D+00 E= 1.354976D+00 + MO Center= 1.3D-13, -3.4D-14, -7.7D-02, r^2= 2.4D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 51 2.451752 1 Se px 54 -1.643832 1 Se px + 57 0.861430 1 Se px 48 -0.695822 1 Se px + 115 -0.559604 2 H px 128 -0.559604 3 H px + 98 0.507015 1 Se d 1 42 -0.427947 1 Se px + 93 -0.306976 1 Se d 1 39 0.247975 1 Se px + + Vector 39 Occ=0.000000D+00 E= 1.430863D+00 + MO Center= 2.0D-14, 4.3D-13, -3.5D-02, r^2= 2.0D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 99 3.605892 1 Se d 2 17 2.473600 1 Se s + 94 -2.442948 1 Se d 2 53 -1.278828 1 Se pz + 108 -1.258767 2 H s 121 -1.258767 3 H s + 97 1.070906 1 Se d 0 16 1.064375 1 Se s + 104 -0.875645 1 Se d 2 107 -0.714262 2 H s + + Vector 40 Occ=0.000000D+00 E= 1.438874D+00 + MO Center= 1.2D-13, 1.3D-13, -6.1D-02, r^2= 1.9D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 95 3.988169 1 Se d -2 90 -2.614497 1 Se d -2 + 100 -0.852014 1 Se d -2 115 -0.478548 2 H px + 128 0.478548 3 H px 80 -0.225547 1 Se d -2 + 85 0.197698 1 Se d -2 75 -0.072906 1 Se d -2 + 70 -0.050272 1 Se d -2 112 0.031112 2 H px + + Vector 41 Occ=0.000000D+00 E= 1.456328D+00 + MO Center= 1.6D-15, -3.6D-14, 6.2D-02, r^2= 1.9D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 98 4.020349 1 Se d 1 93 -2.634404 1 Se d 1 + 54 1.176475 1 Se px 103 -0.785981 1 Se d 1 + 115 -0.578374 2 H px 128 -0.578374 3 H px + 51 -0.317839 1 Se px 83 -0.222571 1 Se d 1 + 88 0.200379 1 Se d 1 57 -0.167693 1 Se px + + Vector 42 Occ=0.000000D+00 E= 1.469265D+00 + MO Center= -5.4D-14, -6.5D-14, 1.1D-01, r^2= 1.9D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 97 4.128096 1 Se d 0 92 -2.689516 1 Se d 0 + 56 -1.935191 1 Se pz 117 0.936357 2 H pz + 130 0.936357 3 H pz 53 0.544878 1 Se pz + 107 -0.483239 2 H s 120 -0.483239 3 H s + 99 -0.465416 1 Se d 2 108 0.409709 2 H s + + Vector 43 Occ=0.000000D+00 E= 1.506674D+00 + MO Center= -8.7D-14, 7.5D-14, 1.2D-01, r^2= 2.5D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 108 4.112364 2 H s 121 -4.112364 3 H s + 96 -3.241263 1 Se d -1 91 2.316849 1 Se d -1 + 52 -1.863971 1 Se py 58 -1.727696 1 Se py + 101 1.252052 1 Se d -1 116 -0.949214 2 H py + 129 -0.949214 3 H py 107 0.912421 2 H s + + Vector 44 Occ=0.000000D+00 E= 2.083568D+00 + MO Center= 5.0D-14, 2.0D-12, -3.7D-01, r^2= 1.9D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 16 14.497548 1 Se s 107 -7.221826 2 H s + 120 -7.221826 3 H s 53 -5.669961 1 Se pz + 99 -3.216454 1 Se d 2 116 2.208931 2 H py + 129 -2.208931 3 H py 15 -1.939271 1 Se s + 56 -1.781163 1 Se pz 17 1.727681 1 Se s + + Vector 45 Occ=0.000000D+00 E= 2.202209D+00 + MO Center= -5.5D-15, -2.0D-12, -2.1D-01, r^2= 1.9D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 107 7.469742 2 H s 120 -7.469742 3 H s + 52 -5.858079 1 Se py 96 5.447395 1 Se d -1 + 91 -2.391168 1 Se d -1 117 2.336493 2 H pz + 130 -2.336493 3 H pz 55 -2.235309 1 Se py + 108 2.094039 2 H s 121 -2.094039 3 H s + + Vector 46 Occ=0.000000D+00 E= 2.624024D+00 + MO Center= -1.8D-14, 1.8D-13, -3.7D-01, r^2= 1.4D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 95 1.697622 1 Se d -2 115 1.511389 2 H px + 128 -1.511389 3 H px 112 -1.410981 2 H px + 125 1.410981 3 H px 100 -1.107808 1 Se d -2 + 90 -0.815039 1 Se d -2 109 0.090592 2 H px + 122 -0.090592 3 H px 85 0.063164 1 Se d -2 + + Vector 47 Occ=0.000000D+00 E= 2.662752D+00 + MO Center= 1.3D-14, -1.6D-12, -3.8D-01, r^2= 1.6D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 16 10.250739 1 Se s 107 -6.376034 2 H s + 120 -6.376034 3 H s 53 -4.418739 1 Se pz + 17 3.411414 1 Se s 97 2.348913 1 Se d 0 + 117 -2.047375 2 H pz 130 -2.047375 3 H pz + 108 -1.784390 2 H s 113 1.777584 2 H py + + Vector 48 Occ=0.000000D+00 E= 2.702180D+00 + MO Center= 8.2D-15, 1.5D-12, -4.5D-01, r^2= 1.5D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 107 5.843782 2 H s 120 -5.843782 3 H s + 52 -4.316834 1 Se py 108 2.422573 2 H s + 121 -2.422573 3 H s 116 -2.261896 2 H py + 129 -2.261896 3 H py 114 1.482930 2 H pz + 127 -1.482930 3 H pz 96 1.249359 1 Se d -1 + + Vector 49 Occ=0.000000D+00 E= 2.830466D+00 + MO Center= 7.4D-15, -1.4D-13, -4.1D-01, r^2= 1.3D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 54 2.275447 1 Se px 98 -1.906616 1 Se d 1 + 115 -1.703036 2 H px 128 -1.703036 3 H px + 112 1.575644 2 H px 125 1.575644 3 H px + 51 -1.296076 1 Se px 103 1.205450 1 Se d 1 + 93 0.989625 1 Se d 1 48 0.303103 1 Se px + + Vector 50 Occ=0.000000D+00 E= 3.001607D+00 + MO Center= -4.0D-14, 5.1D-13, -2.2D-01, r^2= 1.6D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 16 12.272294 1 Se s 107 -6.447833 2 H s + 120 -6.447833 3 H s 14 5.115059 1 Se s + 15 -4.632713 1 Se s 53 -4.536773 1 Se pz + 17 -3.086829 1 Se s 56 -1.685007 1 Se pz + 114 -1.647873 2 H pz 127 -1.647873 3 H pz + + Vector 51 Occ=0.000000D+00 E= 3.315110D+00 + MO Center= 1.2D-14, 6.5D-12, -3.6D-01, r^2= 1.5D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 107 6.379867 2 H s 120 -6.379867 3 H s + 91 4.911713 1 Se d -1 55 -3.670567 1 Se py + 96 -3.687528 1 Se d -1 52 -3.095367 1 Se py + 108 2.872814 2 H s 121 -2.872814 3 H s + 101 2.079886 1 Se d -1 113 -1.842050 2 H py + + Vector 52 Occ=0.000000D+00 E= 3.342501D+00 + MO Center= -4.7D-16, -7.0D-12, -1.8D-01, r^2= 1.3D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 14 7.675557 1 Se s 15 -7.188805 1 Se s + 17 -6.428617 1 Se s 97 3.154872 1 Se d 0 + 56 2.790837 1 Se pz 108 2.529009 2 H s + 121 2.529009 3 H s 92 -2.384944 1 Se d 0 + 13 -2.013792 1 Se s 16 1.693075 1 Se s + + Vector 53 Occ=0.000000D+00 E= 3.684236D+00 + MO Center= 5.5D-15, 3.3D-14, 3.4D-03, r^2= 1.2D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 90 6.983687 1 Se d -2 95 -6.686269 1 Se d -2 + 85 -0.700605 1 Se d -2 100 0.640788 1 Se d -2 + 115 0.333216 2 H px 128 -0.333216 3 H px + 75 -0.219887 1 Se d -2 112 -0.215735 2 H px + 125 0.215735 3 H px 70 -0.055138 1 Se d -2 + + Vector 54 Occ=0.000000D+00 E= 3.701794D+00 + MO Center= 1.6D-14, -5.4D-14, 6.2D-03, r^2= 1.2D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 93 6.974337 1 Se d 1 98 -6.645751 1 Se d 1 + 88 -0.697958 1 Se d 1 54 -0.582973 1 Se px + 103 0.554830 1 Se d 1 115 0.478144 2 H px + 128 0.478144 3 H px 112 -0.297809 2 H px + 125 -0.297809 3 H px 78 -0.219120 1 Se d 1 + + Vector 55 Occ=0.000000D+00 E= 3.721511D+00 + MO Center= 1.9D-14, -2.0D-13, -6.5D-02, r^2= 1.2D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 94 5.423821 1 Se d 2 99 -5.368712 1 Se d 2 + 92 4.289884 1 Se d 0 97 -3.662289 1 Se d 0 + 16 2.629901 1 Se s 17 -1.958056 1 Se s + 14 1.636703 1 Se s 15 -1.587322 1 Se s + 53 -1.085503 1 Se pz 56 0.995681 1 Se pz + + Vector 56 Occ=0.000000D+00 E= 3.760304D+00 + MO Center= -3.5D-14, 1.9D-10, -4.4D-01, r^2= 1.2D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 107 -6.766308 2 H s 120 6.766308 3 H s + 52 6.442994 1 Se py 96 -4.843778 1 Se d -1 + 114 -1.938040 2 H pz 127 1.938040 3 H pz + 91 1.914474 1 Se d -1 113 1.584085 2 H py + 126 1.584085 3 H py 108 0.816454 2 H s + + Vector 57 Occ=0.000000D+00 E= 3.762006D+00 + MO Center= -5.9D-14, -1.9D-10, -6.4D-03, r^2= 1.2D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 16 5.511767 1 Se s 97 5.011005 1 Se d 0 + 92 -4.893001 1 Se d 0 99 -4.652262 1 Se d 2 + 94 4.150743 1 Se d 2 107 -3.775794 2 H s + 120 -3.775794 3 H s 14 -3.074702 1 Se s + 15 2.665591 1 Se s 53 -2.261581 1 Se pz + + Vector 58 Occ=0.000000D+00 E= 4.106889D+00 + MO Center= 1.2D-14, -4.7D-13, 1.4D-01, r^2= 1.1D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 91 7.317595 1 Se d -1 96 -6.314902 1 Se d -1 + 52 -2.412907 1 Se py 55 1.878789 1 Se py + 106 1.175987 2 H s 119 -1.175987 3 H s + 49 1.138994 1 Se py 86 -0.671324 1 Se d -1 + 107 -0.607083 2 H s 120 0.607083 3 H s + + Vector 59 Occ=0.000000D+00 E= 4.459213D+00 + MO Center= 1.0D-13, -1.1D-12, 7.3D-02, r^2= 1.0D+00 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 14 13.766572 1 Se s 15 -11.916532 1 Se s + 53 4.695546 1 Se pz 16 -4.003046 1 Se s + 13 -3.830195 1 Se s 107 3.070045 2 H s + 120 3.070045 3 H s 94 2.157287 1 Se d 2 + 92 -1.502431 1 Se d 0 50 -1.419882 1 Se pz + + Vector 60 Occ=0.000000D+00 E= 5.091334D+00 + MO Center= -7.1D-14, 2.0D-14, 2.6D-02, r^2= 9.0D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 48 3.686113 1 Se px 51 -2.933856 1 Se px + 45 -2.284548 1 Se px 54 1.321595 1 Se px + 42 1.209500 1 Se px 39 -1.098575 1 Se px + 33 -0.763337 1 Se px 30 0.752758 1 Se px + 36 0.441365 1 Se px 57 -0.425096 1 Se px + + Vector 61 Occ=0.000000D+00 E= 5.807717D+00 + MO Center= 9.6D-15, -6.0D-13, -3.1D-01, r^2= 8.2D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 14 6.594967 1 Se s 15 -6.574594 1 Se s + 16 5.518101 1 Se s 50 3.922382 1 Se pz + 53 -3.531923 1 Se pz 99 -2.338170 1 Se d 2 + 107 -2.262388 2 H s 120 -2.262388 3 H s + 47 -2.211016 1 Se pz 94 2.150720 1 Se d 2 + + Vector 62 Occ=0.000000D+00 E= 5.977856D+00 + MO Center= -4.1D-15, 8.1D-13, -1.7D-01, r^2= 8.8D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 96 4.770369 1 Se d -1 91 -4.364702 1 Se d -1 + 49 4.136993 1 Se py 52 -3.701458 1 Se py + 107 2.666263 2 H s 120 -2.666263 3 H s + 46 -2.313513 1 Se py 43 1.197837 1 Se py + 116 -1.131712 2 H py 117 1.134537 2 H pz + + Vector 63 Occ=0.000000D+00 E= 8.289818D+00 + MO Center= -1.6D-14, -3.5D-13, -2.3D-01, r^2= 8.0D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 96 -5.629186 1 Se d -1 91 5.193057 1 Se d -1 + 107 -3.207011 2 H s 120 3.207011 3 H s + 52 2.891386 1 Se py 86 -1.550029 1 Se d -1 + 113 1.277007 2 H py 126 1.277007 3 H py + 49 -1.211657 1 Se py 110 -0.861237 2 H py + + Vector 64 Occ=0.000000D+00 E= 8.565448D+00 + MO Center= 1.8D-14, -4.3D-15, -2.2D-01, r^2= 7.3D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 14 5.671758 1 Se s 16 5.632252 1 Se s + 94 5.364571 1 Se d 2 99 -5.156799 1 Se d 2 + 15 -4.063094 1 Se s 107 -2.793885 2 H s + 120 -2.793885 3 H s 53 -2.653234 1 Se pz + 13 -2.305532 1 Se s 17 -1.833955 1 Se s + + Vector 65 Occ=0.000000D+00 E= 8.726450D+00 + MO Center= -6.3D-14, -8.1D-14, -3.6D-01, r^2= 7.4D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 96 -4.228330 1 Se d -1 91 4.176368 1 Se d -1 + 52 2.083983 1 Se py 107 -1.557310 2 H s + 120 1.557310 3 H s 86 -1.219501 1 Se d -1 + 49 -1.168698 1 Se py 114 -0.985957 2 H pz + 127 0.985957 3 H pz 116 0.886389 2 H py + + Vector 66 Occ=0.000000D+00 E= 8.782916D+00 + MO Center= 7.1D-14, 3.2D-13, -3.3D-01, r^2= 7.5D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 90 4.281855 1 Se d -2 95 -3.918177 1 Se d -2 + 85 -1.524035 1 Se d -2 112 1.037088 2 H px + 125 -1.037088 3 H px 109 -0.957658 2 H px + 122 0.957658 3 H px 100 0.698292 1 Se d -2 + 115 -0.645856 2 H px 128 0.645856 3 H px + + Vector 67 Occ=0.000000D+00 E= 8.838859D+00 + MO Center= -9.5D-15, -4.9D-13, -2.5D-01, r^2= 7.4D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 93 4.906987 1 Se d 1 98 -4.401314 1 Se d 1 + 88 -1.833817 1 Se d 1 112 0.981492 2 H px + 125 0.981492 3 H px 109 -0.870150 2 H px + 122 -0.870150 3 H px 103 0.723308 1 Se d 1 + 54 0.711019 1 Se px 83 0.647059 1 Se d 1 + + Vector 68 Occ=0.000000D+00 E= 8.909562D+00 + MO Center= -1.6D-15, 8.0D-14, 4.9D-02, r^2= 6.2D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 92 6.829490 1 Se d 0 97 -5.859991 1 Se d 0 + 87 -2.689965 1 Se d 0 16 -1.227126 1 Se s + 82 0.967315 1 Se d 0 14 -0.863471 1 Se s + 15 0.798981 1 Se s 94 0.770432 1 Se d 2 + 53 0.717680 1 Se pz 107 0.644279 2 H s + + Vector 69 Occ=0.000000D+00 E= 9.010565D+00 + MO Center= 2.0D-14, 4.0D-14, -1.3D-01, r^2= 6.2D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 90 5.097496 1 Se d -2 95 -3.926437 1 Se d -2 + 85 -2.332088 1 Se d -2 80 0.869659 1 Se d -2 + 112 -0.634282 2 H px 125 0.634282 3 H px + 109 0.532179 2 H px 122 -0.532179 3 H px + 115 0.486117 2 H px 128 -0.486117 3 H px + + Vector 70 Occ=0.000000D+00 E= 9.044410D+00 + MO Center= -2.7D-14, 1.2D-13, -2.1D-01, r^2= 6.3D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 93 4.497708 1 Se d 1 98 -3.369935 1 Se d 1 + 88 -2.097720 1 Se d 1 112 -0.833299 2 H px + 125 -0.833299 3 H px 54 -0.784320 1 Se px + 83 0.785049 1 Se d 1 109 0.668068 2 H px + 115 0.670588 2 H px 122 0.668068 3 H px + + Vector 71 Occ=0.000000D+00 E= 9.225147D+00 + MO Center= -2.7D-15, -2.5D-14, -3.3D-01, r^2= 6.5D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 94 3.148920 1 Se d 2 99 -2.326564 1 Se d 2 + 89 -1.500384 1 Se d 2 14 -1.361595 1 Se s + 114 0.937754 2 H pz 127 0.937754 3 H pz + 13 0.818977 1 Se s 56 0.758882 1 Se pz + 117 -0.755201 2 H pz 130 -0.755201 3 H pz + + Vector 72 Occ=0.000000D+00 E= 9.885851D+00 + MO Center= -7.7D-15, -1.3D-13, -3.0D-01, r^2= 6.4D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 14 10.535698 1 Se s 15 -7.025469 1 Se s + 16 5.417625 1 Se s 13 -4.682290 1 Se s + 53 -2.911913 1 Se pz 94 -2.674020 1 Se d 2 + 107 -2.531089 2 H s 120 -2.531089 3 H s + 99 1.683502 1 Se d 2 50 1.644267 1 Se pz + + Vector 73 Occ=0.000000D+00 E= 1.086874D+01 + MO Center= 1.2D-15, 7.0D-13, -2.6D-01, r^2= 6.5D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 91 4.048489 1 Se d -1 52 -3.538520 1 Se py + 107 3.429468 2 H s 120 -3.429468 3 H s + 86 -2.320075 1 Se d -1 96 -1.993593 1 Se d -1 + 49 1.527946 1 Se py 114 1.264643 2 H pz + 127 -1.264643 3 H pz 113 -1.089839 2 H py + + Vector 74 Occ=0.000000D+00 E= 1.262547D+01 + MO Center= -4.3D-14, -6.5D-13, 2.3D-02, r^2= 4.9D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 14 34.748280 1 Se s 15 -21.361195 1 Se s + 13 -17.290348 1 Se s 12 3.768155 1 Se s + 11 -3.445935 1 Se s 17 -2.239653 1 Se s + 10 2.106463 1 Se s 94 1.236352 1 Se d 2 + 53 1.104850 1 Se pz 107 1.094295 2 H s + + Vector 75 Occ=0.000000D+00 E= 1.739501D+01 + MO Center= 4.3D-14, 5.3D-15, 2.8D-02, r^2= 3.2D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 42 7.751588 1 Se px 45 -5.243668 1 Se px + 39 -5.043381 1 Se px 33 -3.322088 1 Se px + 48 3.259159 1 Se px 30 2.611292 1 Se px + 51 -1.658976 1 Se px 36 1.173420 1 Se px + 54 0.710958 1 Se px 57 -0.202394 1 Se px + + Vector 76 Occ=0.000000D+00 E= 1.789365D+01 + MO Center= 1.9D-15, 1.0D-13, -2.1D-02, r^2= 3.2D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 44 7.998171 1 Se pz 47 -5.672296 1 Se pz + 41 -5.182615 1 Se pz 14 4.468205 1 Se s + 50 4.041420 1 Se pz 16 3.986014 1 Se s + 15 -3.593130 1 Se s 35 -3.371024 1 Se pz + 53 -3.058251 1 Se pz 32 2.653395 1 Se pz + + Vector 77 Occ=0.000000D+00 E= 1.804144D+01 + MO Center= -4.7D-15, 1.1D-14, 4.6D-03, r^2= 3.3D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 43 8.072112 1 Se py 46 -5.787920 1 Se py + 40 -5.222657 1 Se py 49 4.225345 1 Se py + 34 -3.385845 1 Se py 52 -3.226993 1 Se py + 31 2.665424 1 Se py 96 2.316163 1 Se d -1 + 107 2.031151 2 H s 120 -2.031151 3 H s + + Vector 78 Occ=0.000000D+00 E= 2.244119D+01 + MO Center= -3.4D-16, -2.0D-13, -4.3D-01, r^2= 4.6D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 91 -1.138325 1 Se d -1 86 1.089272 1 Se d -1 + 96 1.072945 1 Se d -1 108 -1.021712 2 H s + 121 1.021712 3 H s 81 -0.993246 1 Se d -1 + 106 0.990646 2 H s 119 -0.990646 3 H s + 55 0.963836 1 Se py 105 -0.875992 2 H s + + Vector 79 Occ=0.000000D+00 E= 2.263889D+01 + MO Center= 1.9D-15, 2.2D-13, -4.6D-01, r^2= 4.3D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 17 1.893268 1 Se s 15 -1.049561 1 Se s + 106 0.972481 2 H s 119 0.972481 3 H s + 14 0.898427 1 Se s 105 -0.894077 2 H s + 118 -0.894077 3 H s 56 -0.853985 1 Se pz + 108 -0.832321 2 H s 121 -0.832321 3 H s + + Vector 80 Occ=0.000000D+00 E= 2.364762D+01 + MO Center= 9.7D-16, -9.6D-16, 2.9D-02, r^2= 2.2D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 90 3.594503 1 Se d -2 95 -2.815980 1 Se d -2 + 80 2.627531 1 Se d -2 85 -2.340009 1 Se d -2 + 75 -1.438643 1 Se d -2 100 0.218738 1 Se d -2 + 65 -0.102181 1 Se d -2 70 -0.091851 1 Se d -2 + 115 0.066847 2 H px 128 -0.066847 3 H px + + Vector 81 Occ=0.000000D+00 E= 2.365504D+01 + MO Center= 6.3D-16, -5.3D-15, 2.8D-02, r^2= 2.2D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 92 3.225704 1 Se d 0 97 -2.507518 1 Se d 0 + 82 2.322338 1 Se d 0 87 -2.073664 1 Se d 0 + 94 1.731770 1 Se d 2 99 -1.365593 1 Se d 2 + 77 -1.270600 1 Se d 0 84 1.238514 1 Se d 2 + 89 -1.112739 1 Se d 2 79 -0.676318 1 Se d 2 + + Vector 82 Occ=0.000000D+00 E= 2.365546D+01 + MO Center= 3.6D-15, -4.6D-16, 3.0D-02, r^2= 2.2D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 93 3.606807 1 Se d 1 98 -2.826263 1 Se d 1 + 83 2.628364 1 Se d 1 88 -2.342617 1 Se d 1 + 78 -1.438574 1 Se d 1 103 0.206401 1 Se d 1 + 54 -0.116772 1 Se px 68 -0.102173 1 Se d 1 + 73 -0.091892 1 Se d 1 115 0.090123 2 H px + + Vector 83 Occ=0.000000D+00 E= 2.386915D+01 + MO Center= 4.8D-15, 2.0D-15, -2.7D-03, r^2= 2.5D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 94 3.255432 1 Se d 2 99 -2.573723 1 Se d 2 + 84 2.266517 1 Se d 2 89 -2.043329 1 Se d 2 + 92 -1.700555 1 Se d 0 97 1.329573 1 Se d 0 + 79 -1.229381 1 Se d 2 82 -1.184646 1 Se d 0 + 87 1.068963 1 Se d 0 14 0.844693 1 Se s + + Vector 84 Occ=0.000000D+00 E= 2.435242D+01 + MO Center= -2.0D-16, -1.3D-14, -1.1D-02, r^2= 2.7D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 91 4.226468 1 Se d -1 96 -3.258002 1 Se d -1 + 81 2.582290 1 Se d -1 86 -2.453868 1 Se d -1 + 76 -1.361612 1 Se d -1 52 -0.426753 1 Se py + 106 0.365212 2 H s 119 -0.365212 3 H s + 101 0.346599 1 Se d -1 105 -0.304946 2 H s + + Vector 85 Occ=0.000000D+00 E= 3.816725D+01 + MO Center= 2.1D-14, -6.6D-14, 4.5D-02, r^2= 1.8D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 14 29.108277 1 Se s 13 -19.903138 1 Se s + 11 -17.643094 1 Se s 12 15.923493 1 Se s + 15 -15.250204 1 Se s 10 7.028337 1 Se s + 8 1.643083 1 Se s 17 -1.460952 1 Se s + 9 -1.284635 1 Se s 16 0.940549 1 Se s + + Vector 86 Occ=0.000000D+00 E= 4.746509D+01 + MO Center= -2.4D-14, 1.2D-15, 3.0D-02, r^2= 1.4D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 42 -14.662527 1 Se px 39 14.376405 1 Se px + 33 8.261600 1 Se px 30 -7.294564 1 Se px + 45 4.592477 1 Se px 36 -4.073981 1 Se px + 48 -1.989976 1 Se px 51 0.907185 1 Se px + 54 -0.377673 1 Se px 57 0.111391 1 Se px + + Vector 87 Occ=0.000000D+00 E= 4.795563D+01 + MO Center= -1.6D-16, 3.2D-13, 1.5D-02, r^2= 1.4D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 44 -15.050662 1 Se pz 41 14.629474 1 Se pz + 35 8.295516 1 Se pz 32 -7.321347 1 Se pz + 47 4.942317 1 Se pz 38 -4.102965 1 Se pz + 14 -2.664091 1 Se s 50 -2.432498 1 Se pz + 16 -2.077710 1 Se s 15 1.929729 1 Se s + + Vector 88 Occ=0.000000D+00 E= 4.807678D+01 + MO Center= -4.8D-15, -2.6D-13, 2.5D-02, r^2= 1.4D-01 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 43 -15.153466 1 Se py 40 14.698590 1 Se py + 34 8.307229 1 Se py 31 -7.330962 1 Se py + 46 5.031969 1 Se py 37 -4.111859 1 Se py + 49 -2.539283 1 Se py 52 1.761723 1 Se py + 96 -1.234003 1 Se d -1 107 -0.989424 2 H s + + Vector 89 Occ=0.000000D+00 E= 6.588190D+01 + MO Center= 2.4D-15, 2.1D-15, 3.0D-02, r^2= 7.7D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 75 2.454812 1 Se d -2 80 -1.910329 1 Se d -2 + 90 -1.763603 1 Se d -2 70 -1.658425 1 Se d -2 + 95 1.384768 1 Se d -2 85 1.231438 1 Se d -2 + 100 -0.110519 1 Se d -2 60 -0.039326 1 Se d -2 + 115 -0.032333 2 H px 128 0.032333 3 H px + + Vector 90 Occ=0.000000D+00 E= 6.588673D+01 + MO Center= -8.6D-16, -1.4D-15, 3.0D-02, r^2= 7.7D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 78 2.455104 1 Se d 1 83 -1.911030 1 Se d 1 + 93 -1.769272 1 Se d 1 73 -1.658444 1 Se d 1 + 98 1.389602 1 Se d 1 88 1.232705 1 Se d 1 + 103 -0.104300 1 Se d 1 54 0.058990 1 Se px + 115 -0.043932 2 H px 128 -0.043932 3 H px + + Vector 91 Occ=0.000000D+00 E= 6.589224D+01 + MO Center= 2.3D-17, 1.7D-16, 2.9D-02, r^2= 7.7D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 77 2.239255 1 Se d 0 82 -1.744944 1 Se d 0 + 92 -1.636652 1 Se d 0 72 -1.512123 1 Se d 0 + 97 1.279167 1 Se d 0 87 1.129332 1 Se d 0 + 79 1.009892 1 Se d 2 84 -0.787375 1 Se d 2 + 94 -0.745324 1 Se d 2 74 -0.681866 1 Se d 2 + + Vector 92 Occ=0.000000D+00 E= 6.599067D+01 + MO Center= 2.3D-15, -3.6D-16, 3.1D-02, r^2= 7.8D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 79 2.247674 1 Se d 2 84 -1.765925 1 Se d 2 + 94 -1.694597 1 Se d 2 74 -1.513228 1 Se d 2 + 99 1.350691 1 Se d 2 89 1.163725 1 Se d 2 + 77 -1.013244 1 Se d 0 82 0.795718 1 Se d 0 + 92 0.755816 1 Se d 0 72 0.682239 1 Se d 0 + + Vector 93 Occ=0.000000D+00 E= 6.627723D+01 + MO Center= 3.8D-17, 9.8D-16, 3.5D-02, r^2= 8.0D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 76 2.495460 1 Se d -1 91 -2.148132 1 Se d -1 + 81 -2.011588 1 Se d -1 96 1.696114 1 Se d -1 + 71 -1.664359 1 Se d -1 86 1.401844 1 Se d -1 + 108 -0.296929 2 H s 121 0.296929 3 H s + 101 -0.235105 1 Se d -1 52 0.142008 1 Se py + + Vector 94 Occ=0.000000D+00 E= 1.056024D+02 + MO Center= -6.9D-14, -1.0D-13, 3.8D-02, r^2= 7.5D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 11 40.160610 1 Se s 10 -24.770576 1 Se s + 12 -21.486633 1 Se s 14 -17.530315 1 Se s + 13 13.308838 1 Se s 15 8.828814 1 Se s + 8 -3.773390 1 Se s 9 3.577559 1 Se s + 7 2.676731 1 Se s 6 -1.088291 1 Se s + + Vector 95 Occ=0.000000D+00 E= 1.139215D+02 + MO Center= 9.2D-14, -1.0D-15, 3.0D-02, r^2= 6.6D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 33 24.153016 1 Se px 30 -19.461534 1 Se px + 39 16.458250 1 Se px 42 -13.316709 1 Se px + 36 -10.578037 1 Se px 45 3.004483 1 Se px + 48 -1.184011 1 Se px 27 0.799532 1 Se px + 51 0.534602 1 Se px 54 -0.223643 1 Se px + + Vector 96 Occ=0.000000D+00 E= 1.143649D+02 + MO Center= -8.1D-16, 3.2D-14, 2.2D-02, r^2= 6.6D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 35 24.215282 1 Se pz 32 -19.506528 1 Se pz + 41 16.756525 1 Se pz 44 -13.679876 1 Se pz + 38 -10.645900 1 Se pz 47 3.238904 1 Se pz + 14 -1.747282 1 Se s 50 -1.453327 1 Se pz + 11 1.367896 1 Se s 16 -1.252791 1 Se s + + Vector 97 Occ=0.000000D+00 E= 1.144721D+02 + MO Center= -2.4D-15, 1.2D-13, 2.8D-02, r^2= 6.6D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 34 24.242426 1 Se py 31 -19.527114 1 Se py + 40 16.837213 1 Se py 43 -13.774919 1 Se py + 37 -10.667685 1 Se py 46 3.298032 1 Se py + 49 -1.517134 1 Se py 52 1.046533 1 Se py + 28 0.800505 1 Se py 96 -0.733790 1 Se d -1 + + Vector 98 Occ=0.000000D+00 E= 1.969207D+02 + MO Center= 2.8D-16, 1.0D-15, 3.0D-02, r^2= 2.4D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 70 1.933328 1 Se d -2 65 -1.562920 1 Se d -2 + 75 -1.472222 1 Se d -2 80 0.916362 1 Se d -2 + 90 0.824700 1 Se d -2 95 -0.651316 1 Se d -2 + 85 -0.567325 1 Se d -2 100 0.052928 1 Se d -2 + + Vector 99 Occ=0.000000D+00 E= 1.969237D+02 + MO Center= 1.4D-18, -3.0D-16, 3.0D-02, r^2= 2.4D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 73 1.933403 1 Se d 1 68 -1.562929 1 Se d 1 + 78 -1.472397 1 Se d 1 83 0.916669 1 Se d 1 + 93 0.827270 1 Se d 1 98 -0.653530 1 Se d 1 + 88 -0.567870 1 Se d 1 103 0.049926 1 Se d 1 + 54 -0.028334 1 Se px + + Vector 100 Occ=0.000000D+00 E= 1.969309D+02 + MO Center= -1.1D-16, 3.0D-16, 3.0D-02, r^2= 2.4D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 72 1.770527 1 Se d 0 67 -1.431051 1 Se d 0 + 77 -1.348932 1 Se d 0 82 0.840842 1 Se d 0 + 74 0.777666 1 Se d 2 92 0.769264 1 Se d 0 + 69 -0.628537 1 Se d 2 97 -0.605032 1 Se d 0 + 79 -0.592559 1 Se d 2 87 -0.522768 1 Se d 0 + + Vector 101 Occ=0.000000D+00 E= 1.969991D+02 + MO Center= -6.3D-19, 4.0D-16, 3.0D-02, r^2= 2.5D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 74 1.772720 1 Se d 2 69 -1.431384 1 Se d 2 + 79 -1.354295 1 Se d 2 84 0.850982 1 Se d 2 + 94 0.794003 1 Se d 2 72 -0.778556 1 Se d 0 + 99 -0.635996 1 Se d 2 67 0.628666 1 Se d 0 + 77 0.594726 1 Se d 0 89 -0.538596 1 Se d 2 + + Vector 102 Occ=0.000000D+00 E= 1.972111D+02 + MO Center= 4.0D-18, -1.5D-15, 3.1D-02, r^2= 2.5D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 71 1.944055 1 Se d -1 66 -1.564599 1 Se d -1 + 76 -1.498483 1 Se d -1 91 1.000092 1 Se d -1 + 81 0.965949 1 Se d -1 96 -0.792910 1 Se d -1 + 86 -0.646566 1 Se d -1 108 0.144410 2 H s + 121 -0.144410 3 H s 101 0.112898 1 Se d -1 + + Vector 103 Occ=0.000000D+00 E= 2.501605D+02 + MO Center= -2.9D-14, -1.9D-15, 3.0D-02, r^2= 3.3D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 33 58.136505 1 Se px 30 -50.729375 1 Se px + 36 -13.026311 1 Se px 39 12.642435 1 Se px + 42 -9.288363 1 Se px 45 1.893163 1 Se px + 27 0.877782 1 Se px 48 -0.737308 1 Se px + 51 0.335228 1 Se px 24 -0.290759 1 Se px + + Vector 104 Occ=0.000000D+00 E= 2.505550D+02 + MO Center= 2.2D-14, -3.3D-13, 3.0D-02, r^2= 3.2D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 35 58.306224 1 Se pz 32 -50.860681 1 Se pz + 38 -13.117181 1 Se pz 41 12.877366 1 Se pz + 44 -9.544979 1 Se pz 47 2.041072 1 Se pz + 50 -0.904920 1 Se pz 29 0.878666 1 Se pz + 16 -0.784889 1 Se s 14 -0.725225 1 Se s + + Vector 105 Occ=0.000000D+00 E= 2.506599D+02 + MO Center= -2.7D-16, 3.2D-13, 2.9D-02, r^2= 3.3D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 34 58.353245 1 Se py 31 -50.897235 1 Se py + 37 -13.141799 1 Se py 40 12.940397 1 Se py + 43 -9.613718 1 Se py 46 2.080556 1 Se py + 49 -0.947161 1 Se py 28 0.878925 1 Se py + 52 0.660331 1 Se py 96 -0.463740 1 Se d -1 + + Vector 106 Occ=0.000000D+00 E= 2.836740D+02 + MO Center= 4.2D-14, 1.2D-13, 3.0D-02, r^2= 2.9D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 11 36.849854 1 Se s 10 -29.085360 1 Se s + 12 -15.456099 1 Se s 8 -15.219779 1 Se s + 9 13.885923 1 Se s 14 -9.985279 1 Se s + 7 8.695577 1 Se s 13 7.673320 1 Se s + 15 5.033637 1 Se s 6 -3.931552 1 Se s + + Vector 107 Occ=0.000000D+00 E= 5.164594D+02 + MO Center= -1.0D-14, -1.3D-15, 3.0D-02, r^2= 1.6D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 33 -77.295168 1 Se px 30 73.825395 1 Se px + 36 10.929566 1 Se px 39 -8.593337 1 Se px + 42 6.124699 1 Se px 27 -4.544843 1 Se px + 45 -1.223833 1 Se px 48 0.479307 1 Se px + 51 -0.219379 1 Se px 24 0.200443 1 Se px + + Vector 108 Occ=0.000000D+00 E= 5.168180D+02 + MO Center= 1.8D-14, -7.4D-13, 2.9D-02, r^2= 1.6D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 35 -77.536552 1 Se pz 32 74.031154 1 Se pz + 38 11.008175 1 Se pz 41 -8.755281 1 Se pz + 44 6.295914 1 Se pz 29 -4.549066 1 Se pz + 47 -1.320480 1 Se pz 50 0.589329 1 Se pz + 16 0.519669 1 Se s 14 0.514931 1 Se s + + Vector 109 Occ=0.000000D+00 E= 5.169114D+02 + MO Center= -7.0D-16, 7.9D-13, 3.0D-02, r^2= 1.6D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 34 -77.599776 1 Se py 31 74.085054 1 Se py + 37 11.028760 1 Se py 40 -8.797732 1 Se py + 43 6.340832 1 Se py 28 -4.550176 1 Se py + 46 -1.345853 1 Se py 49 0.616634 1 Se py + 52 -0.433757 1 Se py 96 0.304907 1 Se d -1 + + Vector 110 Occ=0.000000D+00 E= 6.894473D+02 + MO Center= -3.7D-16, -1.5D-15, 3.0D-02, r^2= 6.0D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 60 1.291226 1 Se d -2 65 -1.171544 1 Se d -2 + 70 0.871452 1 Se d -2 75 -0.587319 1 Se d -2 + 80 0.363536 1 Se d -2 90 0.338758 1 Se d -2 + 95 -0.268425 1 Se d -2 85 -0.229213 1 Se d -2 + + Vector 111 Occ=0.000000D+00 E= 6.894489D+02 + MO Center= 1.5D-16, 1.1D-15, 3.0D-02, r^2= 6.0D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 63 1.291228 1 Se d 1 68 -1.171557 1 Se d 1 + 73 0.871484 1 Se d 1 78 -0.587383 1 Se d 1 + 83 0.363651 1 Se d 1 93 0.339801 1 Se d 1 + 98 -0.269328 1 Se d 1 88 -0.229427 1 Se d 1 + + Vector 112 Occ=0.000000D+00 E= 6.894548D+02 + MO Center= -3.2D-17, -7.1D-16, 3.0D-02, r^2= 5.9D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 62 1.186159 1 Se d 0 67 -1.076280 1 Se d 0 + 72 0.800735 1 Se d 0 77 -0.539939 1 Se d 0 + 64 0.510219 1 Se d 2 69 -0.462959 1 Se d 2 + 74 0.344443 1 Se d 2 82 0.334709 1 Se d 0 + 92 0.317131 1 Se d 0 97 -0.250303 1 Se d 0 + + Vector 113 Occ=0.000000D+00 E= 6.894949D+02 + MO Center= -1.8D-16, 5.0D-16, 3.0D-02, r^2= 6.0D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 64 1.186196 1 Se d 2 69 -1.076638 1 Se d 2 + 74 0.801725 1 Se d 2 79 -0.542031 1 Se d 2 + 62 -0.510233 1 Se d 0 67 0.463104 1 Se d 0 + 72 -0.344845 1 Se d 0 84 0.338689 1 Se d 2 + 94 0.326367 1 Se d 2 99 -0.262123 1 Se d 2 + + Vector 114 Occ=0.000000D+00 E= 6.896277D+02 + MO Center= -6.4D-18, 4.8D-16, 3.0D-02, r^2= 6.1D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 61 1.291495 1 Se d -1 66 -1.173402 1 Se d -1 + 71 0.876456 1 Se d -1 76 -0.597804 1 Se d -1 + 91 0.409839 1 Se d -1 81 0.383301 1 Se d -1 + 96 -0.325591 1 Se d -1 86 -0.261319 1 Se d -1 + 108 0.060195 2 H s 121 -0.060195 3 H s + + Vector 115 Occ=0.000000D+00 E= 7.053245D+02 + MO Center= -1.2D-14, 3.4D-14, 3.0D-02, r^2= 1.2D-02 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 8 35.220472 1 Se s 7 -24.248962 1 Se s + 11 -24.105865 1 Se s 10 20.876839 1 Se s + 9 -20.160456 1 Se s 6 9.653647 1 Se s + 12 9.406064 1 Se s 14 5.897458 1 Se s + 5 -5.468167 1 Se s 13 -4.513502 1 Se s + + Vector 116 Occ=0.000000D+00 E= 1.156306D+03 + MO Center= -8.1D-15, -3.7D-16, 3.0D-02, r^2= 6.5D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 33 -56.190111 1 Se px 30 55.732827 1 Se px + 36 6.744162 1 Se px 27 -6.300843 1 Se px + 39 -5.097166 1 Se px 42 3.639062 1 Se px + 24 2.509153 1 Se px 45 -0.737116 1 Se px + 48 0.292040 1 Se px 51 -0.134538 1 Se px + + Vector 117 Occ=0.000000D+00 E= 1.156610D+03 + MO Center= 3.7D-15, -2.0D-13, 3.0D-02, r^2= 6.5D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 35 -56.370584 1 Se pz 32 55.893315 1 Se pz + 38 6.793129 1 Se pz 29 -6.307465 1 Se pz + 41 -5.193697 1 Se pz 44 3.741289 1 Se pz + 26 2.509886 1 Se pz 47 -0.795687 1 Se pz + 50 0.359465 1 Se pz 16 0.321021 1 Se s + + Vector 118 Occ=0.000000D+00 E= 1.156689D+03 + MO Center= 3.9D-19, 2.2D-13, 3.0D-02, r^2= 6.5D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 34 -56.417745 1 Se py 31 55.935254 1 Se py + 37 6.805931 1 Se py 28 -6.309196 1 Se py + 40 -5.218966 1 Se py 43 3.768073 1 Se py + 25 2.510078 1 Se py 46 -0.811039 1 Se py + 49 0.376157 1 Se py 52 -0.266813 1 Se py + + Vector 119 Occ=0.000000D+00 E= 1.534158D+03 + MO Center= -7.0D-15, 9.7D-15, 3.0D-02, r^2= 6.0D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 8 -44.696329 1 Se s 7 41.683759 1 Se s + 6 -22.642410 1 Se s 9 18.323624 1 Se s + 11 15.574394 1 Se s 10 -13.838426 1 Se s + 5 11.060910 1 Se s 12 -5.990269 1 Se s + 14 -3.779409 1 Se s 13 2.882097 1 Se s + + Vector 120 Occ=0.000000D+00 E= 3.038052D+03 + MO Center= 3.0D-15, -2.2D-15, 3.0D-02, r^2= 3.0D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 7 -46.259856 1 Se s 6 45.506397 1 Se s + 8 40.168478 1 Se s 5 -28.618539 1 Se s + 9 -13.793474 1 Se s 11 -10.407590 1 Se s + 10 9.287799 1 Se s 12 4.003575 1 Se s + 14 2.549809 1 Se s 13 -1.940054 1 Se s + + Vector 121 Occ=0.000000D+00 E= 3.100361D+03 + MO Center= -1.2D-15, -1.3D-16, 3.0D-02, r^2= 1.9D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 30 28.196722 1 Se px 33 -28.262355 1 Se px + 27 -3.733891 1 Se px 36 3.365757 1 Se px + 24 2.623481 1 Se px 39 -2.598071 1 Se px + 42 1.871125 1 Se px 21 -1.747781 1 Se px + 45 -0.385339 1 Se px 48 0.154069 1 Se px + + Vector 122 Occ=0.000000D+00 E= 3.100583D+03 + MO Center= -1.2D-15, -2.7D-14, 3.0D-02, r^2= 1.9D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 32 28.278355 1 Se pz 35 -28.353538 1 Se pz + 29 -3.737937 1 Se pz 38 3.390253 1 Se pz + 41 -2.647442 1 Se pz 26 2.624399 1 Se pz + 44 1.923897 1 Se pz 23 -1.747906 1 Se pz + 47 -0.416119 1 Se pz 50 0.189813 1 Se pz + + Vector 123 Occ=0.000000D+00 E= 3.100640D+03 + MO Center= -4.7D-17, 3.5D-14, 3.0D-02, r^2= 1.9D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 31 28.299599 1 Se py 34 -28.377256 1 Se py + 28 -3.738998 1 Se py 37 3.396613 1 Se py + 40 -2.660265 1 Se py 25 2.624647 1 Se py + 43 1.937615 1 Se py 22 -1.747946 1 Se py + 46 -0.424126 1 Se py 49 0.198595 1 Se py + + Vector 124 Occ=0.000000D+00 E= 6.001611D+03 + MO Center= 2.8D-15, -3.6D-16, 3.0D-02, r^2= 1.4D-03 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 6 49.315636 1 Se s 5 -37.926961 1 Se s + 7 -35.570757 1 Se s 8 28.185490 1 Se s + 9 -9.126341 1 Se s 11 -6.808815 1 Se s + 10 6.055982 1 Se s 4 4.064873 1 Se s + 12 2.632121 1 Se s 14 1.693663 1 Se s + + Vector 125 Occ=0.000000D+00 E= 9.942236D+03 + MO Center= 2.1D-16, -2.0D-17, 3.0D-02, r^2= 4.0D-04 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 30 11.387005 1 Se px 33 -11.442549 1 Se px + 27 -1.496023 1 Se px 36 1.390377 1 Se px + 18 1.300248 1 Se px 21 -1.230841 1 Se px + 24 1.151431 1 Se px 39 -1.093129 1 Se px + 42 0.791381 1 Se px 45 -0.164400 1 Se px + + Vector 126 Occ=0.000000D+00 E= 9.942353D+03 + MO Center= -2.9D-16, -6.1D-15, 3.0D-02, r^2= 3.9D-04 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 35 -11.479337 1 Se pz 32 11.419852 1 Se pz + 29 -1.497639 1 Se pz 38 1.400473 1 Se pz + 20 1.300264 1 Se pz 23 -1.230958 1 Se pz + 26 1.151844 1 Se pz 41 -1.113879 1 Se pz + 44 0.813685 1 Se pz 47 -0.177535 1 Se pz + + Vector 127 Occ=0.000000D+00 E= 9.942384D+03 + MO Center= -1.1D-17, 6.9D-15, 3.0D-02, r^2= 3.9D-04 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 34 -11.488943 1 Se py 31 11.428428 1 Se py + 28 -1.498061 1 Se py 37 1.403110 1 Se py + 19 1.300268 1 Se py 22 -1.230988 1 Se py + 25 1.151951 1 Se py 40 -1.119307 1 Se py + 43 0.819525 1 Se py 46 -0.180974 1 Se py + + Vector 128 Occ=0.000000D+00 E= 1.348068D+04 + MO Center= 1.4D-15, -2.5D-17, 3.0D-02, r^2= 4.6D-04 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 6 30.061410 1 Se s 5 -24.775171 1 Se s + 7 -19.866242 1 Se s 8 15.602876 1 Se s + 9 -5.085688 1 Se s 4 4.966180 1 Se s + 11 -3.917622 1 Se s 10 3.465153 1 Se s + 3 -2.219543 1 Se s 12 1.523479 1 Se s + + Vector 129 Occ=0.000000D+00 E= 3.434476D+04 + MO Center= 3.8D-16, 1.1D-17, 3.0D-02, r^2= 1.1D-04 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 6 13.716199 1 Se s 5 -11.352213 1 Se s + 7 -9.160457 1 Se s 8 7.272684 1 Se s + 4 2.606590 1 Se s 9 -2.404789 1 Se s + 3 -2.155555 1 Se s 11 -1.896295 1 Se s + 10 1.671799 1 Se s 2 1.603582 1 Se s + + Vector 130 Occ=0.000000D+00 E= 9.751798D+04 + MO Center= 5.5D-17, 1.9D-18, 3.0D-02, r^2= 1.7D-05 + Bfn. Coefficient Atom+Function Bfn. Coefficient Atom+Function + ----- ------------ --------------- ----- ------------ --------------- + 6 5.112403 1 Se s 5 -4.208607 1 Se s + 7 -3.461494 1 Se s 8 2.764874 1 Se s + 1 -1.270128 1 Se s 2 1.125519 1 Se s + 4 0.954462 1 Se s 9 -0.920201 1 Se s + 3 -0.863635 1 Se s 11 -0.732168 1 Se s + + + center of mass + -------------- + x = 0.00000000 y = 0.00000000 z = 0.03110163 + + moments of inertia (a.u.) + ------------------ + 4.282163369658 0.000000000000 0.000000000000 + 0.000000000000 2.028049376845 0.000000000000 + 0.000000000000 0.000000000000 2.254113992813 + + Multipole analysis of the density + --------------------------------- + + L x y z total alpha beta nuclear + - - - - ----- ----- ---- ------- + 0 0 0 0 -0.000000 -18.000000 -18.000000 36.000000 + + 1 1 0 0 0.000000 0.000000 0.000000 0.000000 + 1 0 1 0 -0.000000 -0.000000 -0.000000 0.000000 + 1 0 0 1 -0.466742 -0.232771 -0.232771 -0.001200 + + 2 2 0 0 -15.190721 -7.595360 -7.595360 0.000000 + 2 1 1 0 0.000000 0.000000 0.000000 0.000000 + 2 1 0 1 -0.000000 -0.000000 -0.000000 0.000000 + 2 0 2 0 -12.733055 -7.484834 -7.484834 2.236613 + 2 0 1 1 -0.000000 -0.000000 -0.000000 0.000000 + 2 0 0 2 -13.610612 -7.779831 -7.779831 1.949049 + + + Task times cpu: 8.8s wall: 8.9s + + + NWChem Input Module + ------------------- + + + Summary of allocated global arrays +----------------------------------- + No active global arrays + + +MA_summarize_allocated_blocks: starting scan ... +MA_summarize_allocated_blocks: scan completed: 0 heap blocks, 0 stack blocks +MA usage statistics: + + allocation statistics: + heap stack + ---- ----- + current number of blocks 0 0 + maximum number of blocks 21 19 + current total bytes 0 0 + maximum total bytes 83496 22515480 + maximum total K-bytes 84 22516 + maximum total M-bytes 1 23 + + + CITATION + -------- + Please cite the following reference when publishing + results obtained with NWChem: + + E. Apra, E. J. Bylaska, W. A. de Jong, N. Govind, K. Kowalski, + T. P. Straatsma, M. Valiev, H. J. J. van Dam, Y. Alexeev, J. Anchell, + V. Anisimov, F. W. Aquino, R. Atta-Fynn, J. Autschbach, N. P. Bauman, + J. C. Becca, D. E. Bernholdt, K. Bhaskaran-Nair, S. Bogatko, P. Borowski, + J. Boschen, J. Brabec, A. Bruner, E. Cauet, Y. Chen, G. N. Chuev, + C. J. Cramer, J. Daily, M. J. O. Deegan, T. H. Dunning Jr., M. Dupuis, + K. G. Dyall, G. I. Fann, S. A. Fischer, A. Fonari, H. Fruchtl, L. Gagliardi, + J. Garza, N. Gawande, S. Ghosh, K. Glaesemann, A. W. Gotz, J. Hammond, + V. Helms, E. D. Hermes, K. Hirao, S. Hirata, M. Jacquelin, L. Jensen, + B. G. Johnson, H. Jonsson, R. A. Kendall, M. Klemm, R. Kobayashi, V. Konkov, + S. Krishnamoorthy, M. Krishnan, Z. Lin, R. D. Lins, R. J. Littlefield, + A. J. Logsdail, K. Lopata, W. Ma, A. V. Marenich, J. Martin del Campo, + D. Mejia-Rodriguez, J. E. Moore, J. M. Mullin, T. Nakajima, D. R. Nascimento, + J. A. Nichols, P. J. Nichols, J. Nieplocha, A. Otero-de-la-Roza, B. Palmer, + A. Panyala, T. Pirojsirikul, B. Peng, R. Peverati, J. Pittner, L. Pollack, + R. M. Richard, P. Sadayappan, G. C. Schatz, W. A. Shelton, D. W. Silverstein, + D. M. A. Smith, T. A. Soares, D. Song, M. Swart, H. L. Taylor, G. S. Thomas, + V. Tipparaju, D. G. Truhlar, K. Tsemekhman, T. Van Voorhis, + A. Vazquez-Mayagoitia, P. Verma, O. Villa, A. Vishnu, K. D. Vogiatzis, + D. Wang, J. H. Weare, M. J. Williamson, T. L. Windus, K. Wolinski, + A. T. Wong, Q. Wu, C. Yang, Q. Yu, M. Zacharias, Z. Zhang, Y. Zhao, + and R. J. Harrison + "NWChem: Past, present, and future + J. Chem. Phys. 152, 184102 (2020) + doi:10.1063/5.0004997 + + AUTHORS + ------- + E. Apra, E. J. Bylaska, N. Govind, K. Kowalski, M. Valiev, W. A. de Jong, + T. P. Straatsma, H. J. J. van Dam, D. Wang, T. L. Windus, N. P. Bauman, + A. Panyala, J. Hammond, J. Autschbach, K. Bhaskaran-Nair, J. Brabec, + K. Lopata, S. A. Fischer, S. Krishnamoorthy, M. Jacquelin, W. Ma, M. Klemm, + O. Villa, Y. Chen, V. Anisimov, F. Aquino, S. Hirata, M. T. Hackler, + Eric Hermes, L. Jensen, J. E. Moore, J. C. Becca, V. Konjkov, + D. Mejia-Rodriguez, T. Risthaus, M. Malagoli, A. Marenich, + A. Otero-de-la-Roza, J. Mullin, P. Nichols, R. Peverati, J. Pittner, Y. Zhao, + P.-D. Fan, A. Fonari, M. J. Williamson, R. J. Harrison, J. R. Rehr, + M. Dupuis, D. Silverstein, D. M. A. Smith, J. Nieplocha, V. Tipparaju, + M. Krishnan, B. E. Van Kuiken, A. Vazquez-Mayagoitia, M. Swart, Q. Wu, + T. Van Voorhis, A. A. Auer, M. Nooijen, L. D. Crosby, E. Brown, G. Cisneros, + G. I. Fann, H. Fruchtl, J. Garza, K. Hirao, R. A. Kendall, J. A. Nichols, + K. Tsemekhman, K. Wolinski, J. Anchell, D. E. Bernholdt, P. Borowski, + T. Clark, D. Clerc, H. Dachsel, M. J. O. Deegan, K. Dyall, D. Elwood, + E. Glendening, M. Gutowski, A. C. Hess, J. Jaffe, B. G. Johnson, J. Ju, + R. Kobayashi, R. Kutteh, Z. Lin, R. Littlefield, X. Long, B. Meng, + T. Nakajima, S. Niu, L. Pollack, M. Rosing, K. Glaesemann, G. Sandrone, + M. Stave, H. Taylor, G. Thomas, J. H. van Lenthe, A. T. Wong, Z. Zhang. + + Total times cpu: 8.8s wall: 8.9s diff --git a/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F b/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F index 9bcab43488..3351648290 100644 --- a/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F +++ b/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F @@ -105,7 +105,7 @@ c other local variables: integer dbg double precision jfac(1),kfac(1) - character*32 pname + character*13 pname c ================================================================= @@ -114,7 +114,7 @@ c dbg = 0: no debug output dbg=1 me=ga_nodeid() master = me.eq.0 - pname = "calc_x2c_1e_scalar" + pname = "x2c_1e_scalar" if (dbg>0.and.master) write(luout,*) 'entering '//pname @@ -148,18 +148,18 @@ c make sure the input GAs have the correct dimension call ga_inquire(g_x2c,type,nc,nc) if (nc.ne.nbf_ao) then - call errquit('x2c1e: g_x2c has wrong dimension',nc,GA_ERR) + call errquit(pname//': g_x2c has wrong dimension',nc,GA_ERR) end if if (.not. bas_numbf(cbas,ntemp)) - & call errquit('x2c1e: bas_ao error',ntemp, BASIS_ERR) + & call errquit(pname//': bas_ao error',ntemp, BASIS_ERR) if (ntemp.ne.nc) - & call errquit('x2c1e: nc.ne.ntemp',ntemp, BASIS_ERR) + & call errquit(pname//': nc.ne.ntemp',ntemp, BASIS_ERR) if (.not. bas_numbf(ubas,nu)) - & call errquit('x2c1e: nu error',nu, BASIS_ERR) + & call errquit(pname//': nu error',nu, BASIS_ERR) if (master.and.dbg>0) write (luout,*) - & 'x2c: nu, nc =',nu,nc + & pname//': nu, nc =',nu,nc if (nu.lt.nc) call errquit( & 'x2c uncontracted basis smaller than contracted', 1, @@ -214,7 +214,7 @@ c in GA, or call relham routines with MA arrays if (.not.rtdb_get(rtdb, 'x2c:usega', mt_log, 1, & use_ga)) continue if (master.and.use_ga) write(luout,*) - & 'x2c: will perform decoupling in GA mode' + & pname//': will perform decoupling in GA mode' c ----------------------------------------- c allocate GAs for T, V, S, and for W = pVp @@ -257,7 +257,7 @@ c symmetrize, just in case ... call ga_sync() - if (master.and.dbg>0) write(luout,*) 'x2c: T,V,S done' + if (master.and.dbg>0) write(luout,*) pname//': T,V,S done' c ------------------------------------------------------ c later we need a transformation from the contracted (c) @@ -283,7 +283,7 @@ c but this is how it is done in the DKH routines) if (.not. ga_create(MT_DBL,nu,nu,'temp',1,1,g_temp)) & call errquit(pname//': error creating temp',53,GA_ERR) - if (master.and.dbg>0) write(luout,*) 'x2c: u2c mem done' + if (master.and.dbg>0) write(luout,*) pname//': u2c mem done' call int_1e_ga(ubas, cbas, g_smix, 'overlap' ,oskel) call ga_copy(g_s,g_temp) @@ -292,12 +292,12 @@ c but this is how it is done in the DKH routines) & g_temp, g_smix, 0.0d0, g_u2c) if (.not. ga_destroy(g_temp)) - & call errquit('x2c1e: error destroy temp',53, GA_ERR) + & call errquit(pname//': error destroy temp',53, GA_ERR) if (.not. ga_destroy(g_smix)) - & call errquit('x2c1e: error destroy smix',52, GA_ERR) + & call errquit(pname//': error destroy smix',52, GA_ERR) - if (master.and.dbg>0) write(luout,*) 'x2c: u2c done' + if (master.and.dbg>0) write(luout,*) pname//': u2c done' end if ! needu2c @@ -314,21 +314,21 @@ c Use [(A^T A)**(-1) A^T] A = 1 to define the left-inverse. if (.not. ga_create(MT_DBL,nc,nc,'temp',1,1,g_temp)) & call errquit(pname//': failed creating temp',55,GA_ERR) - if (master.and.dbg>0) write(luout,*) 'x2c: c2u mem done' + if (master.and.dbg>0) write(luout,*) pname//': c2u mem done' call ga_dgemm('t','n',nc,nc,nu,1.0d0,g_u2c,g_u2c, & 0.0d0,g_temp) call ga_matpow(g_temp, -1.0d0, 1d-12) - if (master.and.dbg>0) write(luout,*) 'x2c: c2u matpow done' + if (master.and.dbg>0) write(luout,*) pname//': c2u matpow done' call ga_dgemm('n','t',nc,nu,nc,1.0d0,g_temp,g_u2c, & 0.0d0,g_c2u) if (.not. ga_destroy(g_temp)) - & call errquit('x2c1e: error destroy temp',55, GA_ERR) + & call errquit(pname//': error destroy temp',55, GA_ERR) - if (master.and.dbg>0) write(luout,*) 'x2c: c2u done' + if (master.and.dbg>0) write(luout,*) pname//': c2u done' c check c2u * u2c @@ -357,9 +357,9 @@ c c2u*u2c must be a unit matrix of dimension nc end if if (.not. ga_destroy(g_temp)) - & call errquit('x2c1e: error destroy temp',56, GA_ERR) + & call errquit(pname//': error destroy temp',56, GA_ERR) - if (master.and.dbg>0) write(luout,*) 'x2c: c2u done' + if (master.and.dbg>0) write(luout,*) pname//': c2u done' end if ! needc2u @@ -381,12 +381,12 @@ c P(u) = u2c P(c) u2c^T. if (.not. ga_create(MT_DBL,nu,nu,'densu',1,1,g_densu)) & call errquit(pname//': error creating densu',58,GA_ERR) - if (master.and.dbg>0) write(luout,*) 'x2c: dens c2u start' + if (master.and.dbg>0) write(luout,*) pname//': dens c2u start' call ga_zero(g_densu) call ga_dgemm('n','t',nc,nu,nc, 1.0d0, & g_dens(1),g_u2c,0.0d0,g_temp) - if (master.and.dbg>0) write(luout,*) 'x2c: dens c2u step1' + if (master.and.dbg>0) write(luout,*) pname//': dens c2u step1' call ga_dgemm('n','n',nu,nu,nc ,1.0d0, & g_u2c, g_temp, 0.0d0,g_densu) call ga_symmetrize(g_densu) @@ -394,7 +394,7 @@ c P(u) = u2c P(c) u2c^T. if (.not. ga_destroy(g_temp)) & call errquit(pname//': error destroy temp',57, GA_ERR) - if (master.and.dbg>0) write(luout,*) 'x2c: dens c2u done' + if (master.and.dbg>0) write(luout,*) pname//': dens c2u done' else @@ -419,7 +419,7 @@ c ------------------------------------ & errquit(pname//': ga_create g_temp failed',59,GA_ERR) call ga_zero(g_temp) - if (master.and.dbg>0) write(luout,*) 'x2c: debug S:' + if (master.and.dbg>0) write(luout,*) pname//': debug S:' call ga_dgemm('n','n',nu,nu,nu, 1.0d0, & g_densu,g_s,0.0d0,g_temp) @@ -427,9 +427,9 @@ c ------------------------------------ sum = ga_trace_diag(g_temp) if (master) write (luout,'(1x,a,1x,e15.7)') - & 'calc_x2c: tr(P * S) : ',sum + & pname//': tr(P * S) : ',sum - if (master.and.dbg>0) write(luout,*) 'x2c: debug T:' + if (master.and.dbg>0) write(luout,*) pname//': debug T:' call ga_dgemm('n','n',nu,nu,nu, 1.0d0, & g_densu,g_t,0.0d0,g_temp) @@ -437,10 +437,10 @@ c ------------------------------------ sum = ga_trace_diag(g_temp) if (master) write (luout,'(1x,a,1x,e15.7)') - & 'calc_x2c: tr(P * T) : ',sum + & pname//': tr(P * T) : ',sum energy = energy + sum - if (master.and.dbg>0) write(luout,*) 'x2c: debug V:' + if (master.and.dbg>0) write(luout,*) pname//': debug V:' call ga_dgemm('n','n',nu,nu,nu, 1.0d0, & g_densu,g_v,0.0d0,g_temp) @@ -448,14 +448,14 @@ c ------------------------------------ sum = ga_trace_diag(g_temp) if (master) write (luout,'(1x,a,1x,e15.7)') - & 'calc_x2c: tr(P * V) : ',sum + & pname//': tr(P * V) : ',sum energy = energy + sum if (.not. ga_destroy(g_temp)) call errquit & (pname//': temp ga corrupt?',59, GA_ERR) if (master) write (luout,'(1x,a,1x,e15.7)') - & 'calc_x2c: 1e energy : ',energy + & pname//': 1e energy : ',energy c ---------------------------------------------------------- c as this routine gets embedded in the scalar DFT framework, @@ -536,7 +536,7 @@ c --------------------------------------------------------------- if (analytic_pvp) then if (master) write (luout,*) - & 'x2c: calculating analytic p.Vp integrals' + & pname//': calculating analytic p.Vp integrals' c add scalar part p.Vp to g_w: call int_1e_ga(ubas, ubas ,g_w, 'pvp' ,oskel) @@ -552,10 +552,11 @@ c integrals are done analytically c -------------------------------------------------- if (analytic_pvp .and. .not.modelpot_2e) then - if (master) write(luout,*)'x2c: skipping numerical W integrals' + if (master) write(luout,*) + & pname//': skipping numerical W integrals' else - if (master) write(luout,*) 'x2c: calculating W numerically' + if (master) write(luout,*) pname//': calculating W numerically' if (modelpot_2e .and. master) & write(luout,*) ' (2e model pot. only)' @@ -575,14 +576,14 @@ c g_vxc has the right dimension already c transform to ubas: tmpv = c2u^T g_tmpv c2u, add to g_w if(.not.ga_create(mt_dbl,nc,nu,'temp',0,0,g_temp)) - & call errquit('x2c1e: error creating temp',148, GA_ERR) + & call errquit(pname//': error creating temp',148, GA_ERR) call ga_zero(g_temp) call ga_dgemm('n','n',nc,nu,nc, 1.0d0, & g_tmpv,g_c2u,0.0d0,g_temp) - if (master.and.dbg>0) write(luout,*) 'x2c: g_w c2u step1' + if (master.and.dbg>0) write(luout,*) pname//': g_w c2u step1' call ga_dgemm('t','n',nu,nu,nc ,1.0d0, & g_c2u, g_temp, 1.0d0,g_w) - if (master.and.dbg>0) write(luout,*) 'x2c: g_w c2u step2' + if (master.and.dbg>0) write(luout,*) pname//': g_w c2u step2' if (.not. ga_destroy(g_tmpv)) call errquit & (pname//': ga corrupt?',147, GA_ERR) if (.not. ga_destroy(g_temp)) call errquit @@ -604,7 +605,7 @@ c sanity checks: if (.not.needu2c) then if (g_X.ne.g_x2c) call errquit( - & 'x2c1e: g_X/g_x2c inconsistency 1',g_X-g_x2c, UNKNOWN_ERR) + & pname//': g_X/g_x2c inconsistency 1',g_X-g_x2c, UNKNOWN_ERR) end if c ----------------------------------------------- @@ -918,9 +919,10 @@ c store in g_x2c. Otherwise, we are already done c ---------------------------------------------- if (needu2c) then - if (dbg>0.and.master) write(luout,*) 'x2c: u2c trafo of result' + if (dbg>0.and.master) write(luout,*) + & pname//': u2c trafo of result' if (.not. ga_create(MT_DBL,nc,nu,'temp',1,1,g_temp)) - & call errquit('x2c1e: ga_create failed temp',77, + & call errquit(pname//': ga_create failed temp',77, & GA_ERR) if (g_X.eq.g_x2c) call errquit( & pname//': g_X/g_x2c inconsistency 3',g_X-g_x2c, UNKNOWN_ERR) @@ -933,7 +935,7 @@ c same. Hence, g_x2c is over-written here & g_temp,g_u2c, 0.0d0,g_x2c) if (.not. ga_destroy(g_temp)) - & call errquit('x2c1e: ga_destroy failed temp',77,GA_ERR) + & call errquit(pname//': ga_destroy failed temp',77,GA_ERR) end if ! needu2c call ga_symmetrize(g_x2c) @@ -942,7 +944,7 @@ c de-allocate g_X, if needed, and related arrays if (needu2c) then if (.not. ga_destroy(g_X)) - & call errquit('x2c1e: ga_destroy failed g_X',61,GA_ERR) + & call errquit(pname//': ga_destroy failed g_X',61,GA_ERR) if (.not.keepU) then if (.not. ga_destroy(g_u2c)) call errquit From dd642e3434739ea920b71979b51113c5933c5844 Mon Sep 17 00:00:00 2001 From: edoapra Date: Tue, 12 Apr 2022 21:40:17 -0700 Subject: [PATCH 09/15] refactoring --- src/nwdft/scf_dft/GNUmakefile | 2 +- src/nwdft/scf_dft/dft_quickguess.F | 41 +++++++++ src/nwdft/scf_dft/dft_scf.F | 123 +++++--------------------- src/nwdft/x2c/GNUmakefile | 2 +- src/nwdft/x2c/calc_x2c_1e_scalar_ga.F | 62 +++++++------ src/nwdft/x2c/x2c_scf.F | 106 ++++++++++++++++++++++ src/nwdft/x2c/x2c_scf.fh | 8 ++ 7 files changed, 208 insertions(+), 136 deletions(-) create mode 100644 src/nwdft/scf_dft/dft_quickguess.F create mode 100644 src/nwdft/x2c/x2c_scf.F create mode 100644 src/nwdft/x2c/x2c_scf.fh diff --git a/src/nwdft/scf_dft/GNUmakefile b/src/nwdft/scf_dft/GNUmakefile index e1134d1b92..6f295f0d97 100644 --- a/src/nwdft/scf_dft/GNUmakefile +++ b/src/nwdft/scf_dft/GNUmakefile @@ -40,7 +40,7 @@ dft_fant.o\ dft_printinfo.o\ dft_fock_efield.o\ - dft_frac_mo.o dft_nwmolden.o dft_spinflip.o + dft_frac_mo.o dft_nwmolden.o dft_spinflip.o dft_quickguess.o LIBRARY = libnwdft.a #_USE_SCALAPACK = $(shell cat ${NWCHEM_TOP}/src/tools/build/config.h | awk ' /HAVE_SCALAPACK\ 1/ {print "Y"}') diff --git a/src/nwdft/scf_dft/dft_quickguess.F b/src/nwdft/scf_dft/dft_quickguess.F new file mode 100644 index 0000000000..9de72f53f1 --- /dev/null +++ b/src/nwdft/scf_dft/dft_quickguess.F @@ -0,0 +1,41 @@ + subroutine dft_quickguess(ipol,nbf_ao,g_dens,oskel, + N ntotel,nclosed, + D densmat) + implicit none +#include "global.fh" +#include "errquit.fh" + integer ipol + integer nbf_ao + logical oskel + integer ntotel,nclosed + integer g_dens(*) + logical densmat ![in] +c + character*256 file_mat1 +c + if(densmat) then + call util_file_name('densmat', .false.,.false.,file_mat1) + if(ga_nodeid().eq.0) + W write(6,*) ' reading DM from file ',file_mat1 + call ao_1prdm_read(nbf_ao,g_dens(1),file_mat1) + endif + + if(ipol.eq.2) then + if(densmat) then + call errquit(' code not ready for open-shell ',0,CAPMIS_ERR) + call util_file_name('densmat', .false.,.false.,file_mat1) + if(ga_nodeid().eq.0) + W write(6,*) ' reading DM from file ',file_mat1 + call ao_1prdm_read(nbf_ao,g_dens(2),file_mat1) + else + call ga_copy(g_dens(1),g_dens(2)) + call ga_dscal(g_dens(1),dble(ntotel-nclosed)/(ntotel)) + call ga_dscal(g_dens(2),dble(nclosed)/(ntotel)) + endif + endif + if(oskel) then + call ga_symmetrize(g_dens(1)) + if(ipol.eq.2) call ga_symmetrize(g_dens(2)) + endif + return + end diff --git a/src/nwdft/scf_dft/dft_scf.F b/src/nwdft/scf_dft/dft_scf.F index 0c0c3c76c2..c555e59e2b 100644 --- a/src/nwdft/scf_dft/dft_scf.F +++ b/src/nwdft/scf_dft/dft_scf.F @@ -226,17 +226,17 @@ c gotsmear(ss)=abs(ss).gt.1d-9 c c ... exact decoupling and other relativistic Hamiltonians - integer g_rel(2), g_x2c_u(2), g_x2c_u2c, g_x2c_c2u - logical lx2c_efg, lx2c_moment, lx2c_hfc, lx2c_keepU - logical lx2c_c2u, lx2c_u2c, lx2c_noatm, ltemp + integer g_rel(2) + integer g_x2c_u(2), g_x2c_u2c, g_x2c_c2u c c misc c logical debug_fon logical do_zora_recalc, zora_recalc - external zora_recalc - integer dbg -c + external zora_recalcc + logical x2c_noatm + external x2c_noatm + c MN solvation models --> c double precision gcds, gspol, espol, gspoldyn, gspolneq @@ -289,7 +289,6 @@ c <-- MN solvation models c c ========================================================================= c - dbg=0 ! debug level during code development. c k_3cERI = 0 k_3cwhat = 0 @@ -337,8 +336,6 @@ c I changed the array name for g_zora_sf to g_rel and use c it now for both methods. c --------------------------------------------------------- - if(me.eq.0 .and. dbg>0) - & write(luout,*) 'do_x2c =',do_x2c c make sure we don't use zora, x2c, or another c two-component relativistic method at the same time @@ -357,26 +354,6 @@ c write output about the relativistic treatment if (me.eq.0) write (luout,*) 'dft: using X2C' end if -c check for additional x2c keywords and set -c lx2c_keepU to T if we need it for any of the properties: - - lx2c_keepU = .false. - lx2c_efg = .false. - if (rtdb_get(rtdb, 'x2c:efg', mt_log, 1, - & lx2c_efg)) lx2c_keepU = .true. - lx2c_hfc = .false. - if (rtdb_get(rtdb, 'x2c:hfc', mt_log, 1, - & lx2c_hfc)) lx2c_keepU = .true. - lx2c_moment = .false. - if (rtdb_get(rtdb, 'x2c:moment', mt_log, 1, - & lx2c_moment)) lx2c_keepU = .true. - lx2c_noatm = .false. - if (rtdb_get(rtdb, 'x2c:noatm', mt_log, 1, - & lx2c_noatm)) continue - - if (lx2c_efg .and. me.eq.0) write (luout,*) - & 'x2c: will calculate EFGs, too' - c c !!! BGJ c Store SCF hamiltonian type as DFT for use in BGJ routines @@ -716,18 +693,14 @@ c calculate superposition of atomic densities c if ZORA or X2C functionality is requested c ------------------------------------------- - if ((do_zora .or. do_x2c) .and. .not.lx2c_noatm) then + if ((do_zora .or. do_x2c) .and. .not.x2c_noatm()) then call ga_zero(g_dens_at(1)) if (ipol.gt.1) call ga_zero(g_dens_at(2)) call guess_dens(rtdb, geom, ao_bas_han, g_dens_at) - if (oskel) call ga_symmetrize(g_dens_at(1)) - if(ipol.gt.1) then - call ga_copy(g_dens_at(1),g_dens_at(2)) - call ga_dscal(g_dens_at(1),dble(ntotel-nclosed)/(ntotel)) - call ga_dscal(g_dens_at(2),dble(nclosed)/(ntotel)) - if(oskel) call ga_symmetrize(g_dens_at(2)) - end if - else if (do_x2c .and. lx2c_noatm) then + call dft_quickguess(ipol,nbf_ao,g_dens_at,oskel, + N ntotel,nclosed, + D .false.) + else if (do_x2c .and. x2c_noatm()) then call ga_zero(g_dens_at(1)) if (ipol.gt.1) call ga_zero(g_dens_at(2)) end if ! do_zora .or. do_x2c @@ -872,19 +845,19 @@ c g_x2c_u2c is created in the x2c routine and survives c if keepU=.T. Same for the transformation matrices g_xc_u(:). c optionally, g_x2c_c2u is also allocated and kept. - call calc_x2c_1e_scalar_ga(rtdb, lx2c_keepU, - & lx2c_u2c, lx2c_c2u, + call calc_x2c_1e_scalar_ga(rtdb, & nexc, g_dens_at, g_vxc, g_rel(1), g_x2c_u, & g_x2c_u2c, g_x2c_c2u, toll_s) c debug: print the X2C U matrices - - if(me.eq.0 .and. dbg>1) then +#ifdef DEBUG + if(me.eq.0) then write (luout,*) 'x2c U-L' call ga_print(g_x2c_u(1)) write (luout,*) 'x2c U-S' call ga_print(g_x2c_u(2)) - end if ! debug + end if ! debug +#endif if (ipol.gt.1) then if(.not.ga_duplicate(g_vxc(2),g_rel(2),'x2c 2')) @@ -937,30 +910,9 @@ c == better have static ldb at high node counts == if (.not. rtdb_cput(rtdb, 'dft:output vectors', 1, movecs_out)) $ call errquit('dft_scf: DFT MO vectors not defined',0, & RTDB_ERR) - if(densmat) then - call util_file_name('densmat', .false.,.false.,file_mat1) - if(ga_nodeid().eq.0) - W write(6,*) ' reading DM from file ',file_mat1 - call ao_1prdm_read(nbf_ao,g_dens(1),file_mat1) - endif - - if(ipol.eq.2) then - if(densmat) then - call errquit(' code not ready for open-shell ',0,CAPMIS_ERR) - call util_file_name('densmat', .false.,.false.,file_mat1) - if(ga_nodeid().eq.0) - W write(6,*) ' reading DM from file ',file_mat1 - call ao_1prdm_read(nbf_ao,g_dens(2),file_mat1) - else - call ga_copy(g_dens(1),g_dens(2)) - call ga_dscal(g_dens(1),dble(ntotel-nclosed)/(ntotel)) - call ga_dscal(g_dens(2),dble(nclosed)/(ntotel)) - endif - endif - if(oskel) then - call ga_symmetrize(g_dens(1)) - if(ipol.eq.2) call ga_symmetrize(g_dens(2)) - endif + call dft_quickguess(ipol,nbf_ao,g_dens,oskel, + N ntotel,nclosed, + D densmat) goto 1789 endif if(oskel) then @@ -2002,21 +1954,6 @@ c AOR end c ... jochen: calculate x2c properties if so requested: if (do_x2c) then - if (lx2c_efg) then -c x2c EFG - if (me.eq.0 .and. dbg>0) - & write (luout,*) 'calling calc_x2c_efg' - call calc_x2c_efg_scalar(rtdb, - & nexc, g_dens, g_dens_at, g_x2c_u) - end if - - if (lx2c_moment) then -c x2c dipole moment - if (me.eq.0 .and. dbg>0) - & write (luout,*) 'calling x2c_moment' - call calc_x2c_moment_scalar(rtdb, - & nexc, g_dens, g_dens_at, g_x2c_u, 'dipole', 3) - end if end if ! do_x2c c vdw bit @@ -2642,26 +2579,8 @@ c Deallocate zora related arrays c c deallocate x2c arrays if necessary if (do_x2c) then - if (.not. ga_destroy(g_rel(1))) call errquit( - & 'dft_scf: ga_destroy failed g_rel',0, GA_ERR) - if (ipol.gt.1) then - if (.not. ga_destroy(g_rel(1))) call errquit( - & 'dft_scf: ga_destroy failed g_rel',0, GA_ERR) - end if - if (lx2c_keepU) then - if(.not.ga_destroy(g_x2c_u(1))) call errquit( - & 'dft_scf: ga_destroy failed x2c_u(1)',1, GA_ERR) - if(.not.ga_destroy(g_x2c_u(2))) call errquit( - & 'dft_scf: ga_destroy failed x2c_u(2)',2, GA_ERR) - if (lx2c_u2c) then - if(.not.ga_destroy(g_x2c_u2c)) call errquit( - & 'dft_scf: ga_destroy failed x2c_u2c',51, GA_ERR) - end if - if (lx2c_c2u) then - if(.not.ga_destroy(g_x2c_c2u)) call errquit( - & 'dft_scf: ga_destroy failed x2c_c2u',54, GA_ERR) - end if - end if + call x2c_scf_terminate(rtdb,ipol,g_rel, + g g_x2c_u,g_x2c_u2c,g_x2c_c2u) end if ! do_x2c c c AOR begin diff --git a/src/nwdft/x2c/GNUmakefile b/src/nwdft/x2c/GNUmakefile index afc1280044..5910dd8b62 100644 --- a/src/nwdft/x2c/GNUmakefile +++ b/src/nwdft/x2c/GNUmakefile @@ -12,7 +12,7 @@ calc_x2c_wmoment_scalar.o \ write_x2c_pc_dip.o \ read_x2c_pc_dip.o \ - ma_solve.o + ma_solve.o x2c_scf.o LIBRARY = libnwdft.a diff --git a/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F b/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F index 3351648290..4d22fca181 100644 --- a/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F +++ b/src/nwdft/x2c/calc_x2c_1e_scalar_ga.F @@ -1,4 +1,4 @@ - subroutine calc_x2c_1e_scalar_ga (rtdb, keepU, needu2c, needc2u, + subroutine calc_x2c_1e_scalar_ga (rtdb, & nexc, g_dens, g_vxc, g_x2c, g_u, g_u2c, g_c2u, toll_s) c ----------------------------------------------------------------- @@ -59,11 +59,11 @@ c ----------------------------------------------------------------- #include "rel_consts.fh" #include "cint1cache.fh" #include "numerical_constants.fh" +#include "x2c_scf.fh" c subroutine arguments: integer rtdb ! [inp] runtime database GA handle - logical keepU ! [inp] keep U-matrix? integer nexc ! [inp] no. of XC terms integer g_dens(2) ! [inp] atom densities for model pot. integer g_vxc(4) ! scratch @@ -71,8 +71,6 @@ c subroutine arguments: integer g_u(2) ! [out] decoupling transformation integer g_u2c ! [out] basis trafo integer g_c2u ! [out] basis trafo - logical needu2c ! [out] u2c trafo needed? - logical needc2u ! [out] c2u trafo needed? double precision toll_s ! [inp] Smat diag. tolerance c GA handles used for temp storage in this routine: @@ -165,9 +163,9 @@ c make sure the input GAs have the correct dimension & 'x2c uncontracted basis smaller than contracted', 1, & RTDB_ERR) - needu2c = (nu.gt.nc) + lx2c_u2c = (nu.gt.nc) if (master) then - if (needu2c) then + if (lx2c_u2c) then write (luout,*) & 'x2c INFO: the operator will be calculated in an' write (luout,*) @@ -203,8 +201,8 @@ c if analyticpvp is .F. or if we need the model potential, c we also need a contracted-to-uncontracted basis transformation c unless the two bases are identical - needc2u = ((.not.analytic_pvp .or. modelpot_2e).and.needu2c) - if (master.and.needc2u) write (luout,*) + lx2c_c2u = ((.not.analytic_pvp .or. modelpot_2e).and.lx2c_u2c) + if (master.and.lx2c_c2u) write (luout,*) & 'x2c INFO: x2c options require constructing the c2u trafo' c check rtdb switch to see whether we should perform decoupling @@ -270,7 +268,7 @@ c u2c transforms the basis from uncontracted to contracted c (really, these are just the contraction coefficients, c but this is how it is done in the DKH routines) - if (needu2c) then + if (lx2c_u2c) then if (.not. ga_create(MT_DBL,nu,nc,'u2c',1,1,g_u2c)) & call errquit(pname//': create u2c failed',51,GA_ERR) @@ -299,13 +297,13 @@ c but this is how it is done in the DKH routines) if (master.and.dbg>0) write(luout,*) pname//': u2c done' - end if ! needu2c + end if ! lx2c_u2c c c2u transforms the basis from contracted to uncontracted. c we have to do this as a generalized left-inverse of u2c. c Use [(A^T A)**(-1) A^T] A = 1 to define the left-inverse. - if (needc2u) then + if (lx2c_c2u) then if (.not. ga_create(MT_DBL,nc,nu,'c2u',1,1,g_c2u)) & call errquit(pname//': create c2u failed',54,GA_ERR) @@ -361,9 +359,9 @@ c c2u*u2c must be a unit matrix of dimension nc if (master.and.dbg>0) write(luout,*) pname//': c2u done' - end if ! needc2u + end if ! lx2c_c2u - if (needu2c) then + if (lx2c_u2c) then c transform density matrix to the uncontracted basis: c c2u is how the basis would transform in this case. @@ -403,7 +401,7 @@ c just assign the GA handle of g_dens(1) to g_densu g_densu = g_dens(1) - end if ! needu2c + end if ! lx2c_u2c if (master.and.dbg>0) write (luout,*) & 'g_densu, g_dens(1) = ',g_densu,g_dens(1) @@ -464,17 +462,17 @@ c we need to SUBTRACT the nonrel H from the operator. c this is done here, upfront. c ---------------------------------------------------------- -c if needu2c is .T., we now need to allocate an array for the +c if lx2c_u2c is .T., we now need to allocate an array for the c x2c operator in the uncontracted basis => g_X c otherwise, we simply use the GA handle of g_x2c. - if (needu2c) then + if (lx2c_u2c) then if (.not.ga_duplicate(g_s, g_X, 'g_X')) call & errquit(pname//': ga_create failed g_X',61,GA_ERR) call ga_zero(g_X) else g_X = g_x2c - end if ! needu2c + end if ! lx2c_u2c call ga_dadd(1.d0, g_X, -1.0d0, g_t, g_X) call ga_dadd(1.d0, g_X, -1.0d0, g_v, g_X) @@ -516,7 +514,7 @@ c add Coul. pot. to g_v: end if ! modelpot_2e c g_densu not needed past this point - if (needu2c) then + if (lx2c_u2c) then if (.not. ga_destroy(g_densu)) & call errquit(pname//': error destroy densu',58, GA_ERR) else @@ -561,7 +559,7 @@ c -------------------------------------------------- & write(luout,*) ' (2e model pot. only)' - if (needu2c) then + if (lx2c_u2c) then c here we need to use the contracted basis ... c use g_tmpv to hold the array. @@ -594,7 +592,7 @@ c cbas = ubas. Just continue as usual call x2c_getw_scalar(rtdb, g_dens(1), g_w, g_vxc, nexc, & analytic_pvp, .not.modelpot_2e) if (dbg>0.and.master) write (luout,*) 'g_w numint end' - end if ! needu2c + end if ! lx2c_u2c end if ! need analytic integration @@ -603,7 +601,7 @@ c W is the pVp matrix, incl model pot if requested: c sanity checks: - if (.not.needu2c) then + if (.not.lx2c_u2c) then if (g_X.ne.g_x2c) call errquit( & pname//': g_X/g_x2c inconsistency 1',g_X-g_x2c, UNKNOWN_ERR) end if @@ -887,7 +885,7 @@ c if we don't keep the transformation we also don't c need to keep the u2c [or c2u] transformation c ----------------------------------------------------- - if (keepU) then + if (lx2c_keepU) then if (.not. ga_create(MT_DBL,nu,nu,'x2c_UL',1,1,g_u(1))) & call errquit(pname//': ga_create failed UL',75, GA_ERR) if (.not. ga_create(MT_DBL,nu,nu,'x2c_US',1,1,g_u(2))) @@ -896,7 +894,7 @@ c ----------------------------------------------------- call ga_copy(g_s, g_u(1)) call ga_copy(g_m, g_u(2)) call ga_scale(g_u(2), c_2c) - end if ! keepU + end if ! lx2c_keepU if (.not. ga_destroy(g_s)) & call errquit(pname//': ga_destroy failed s',11, GA_ERR) @@ -908,7 +906,7 @@ c ----------------------------------------------------- c sanity check: - if (.not.needu2c) then + if (.not.lx2c_u2c) then if (g_X.ne.g_x2c) call errquit( & pname//': g_X/g_x2c inconsistency 2',g_X-g_x2c, UNKNOWN_ERR) end if @@ -918,7 +916,7 @@ c transform x2c operator to contracted basis and c store in g_x2c. Otherwise, we are already done c ---------------------------------------------- - if (needu2c) then + if (lx2c_u2c) then if (dbg>0.and.master) write(luout,*) & pname//': u2c trafo of result' if (.not. ga_create(MT_DBL,nc,nu,'temp',1,1,g_temp)) @@ -929,32 +927,32 @@ c ---------------------------------------------- call ga_dgemm('t','n',nc,nu,nu,1.0d0, & g_u2c,g_X,0.0d0,g_temp) -c note: if needu2c.eq..T. then g_x2c and g_X are not the +c note: if lx2c_u2c.eq..T. then g_x2c and g_X are not the c same. Hence, g_x2c is over-written here call ga_dgemm('n','n',nc,nc,nu,1.0d0, & g_temp,g_u2c, 0.0d0,g_x2c) if (.not. ga_destroy(g_temp)) & call errquit(pname//': ga_destroy failed temp',77,GA_ERR) - end if ! needu2c + end if ! lx2c_u2c call ga_symmetrize(g_x2c) c de-allocate g_X, if needed, and related arrays - if (needu2c) then + if (lx2c_u2c) then if (.not. ga_destroy(g_X)) & call errquit(pname//': ga_destroy failed g_X',61,GA_ERR) - if (.not.keepU) then + if (.not.lx2c_keepU) then if (.not. ga_destroy(g_u2c)) call errquit & (pname//': ga_destroy failed u2c',51,GA_ERR) end if - end if ! needu2c - if (needc2u .and. .not.keepU) then + end if ! lx2c_u2c + if (lx2c_c2u .and. .not.lx2c_keepU) then if (.not. ga_destroy(g_c2u)) call errquit & (pname//': ga_destroy failed c2u',54,GA_ERR) - end if ! needc2u + end if ! lx2c_c2u c restore model alpha and beta densities: diff --git a/src/nwdft/x2c/x2c_scf.F b/src/nwdft/x2c/x2c_scf.F new file mode 100644 index 0000000000..193a12fd70 --- /dev/null +++ b/src/nwdft/x2c/x2c_scf.F @@ -0,0 +1,106 @@ + subroutine x2c_scf_init(rtdb) + implicit none + integer rtdb +#include "rtdb.fh" +#include "mafdecls.fh" +#include "global.fh" +#include "stdio.fh" +#include "x2c_scf.fh" +c + integer me +c check for additional x2c keywords and set +c lx2c_keepU to T if we need it for any of the properties: + me=ga_nodeid() + lx2c_keepU = .false. + lx2c_efg = .false. + if (rtdb_get(rtdb, 'x2c:efg', mt_log, 1, + & lx2c_efg)) lx2c_keepU = .true. + lx2c_hfc = .false. + if (rtdb_get(rtdb, 'x2c:hfc', mt_log, 1, + & lx2c_hfc)) lx2c_keepU = .true. + lx2c_moment = .false. + if (rtdb_get(rtdb, 'x2c:moment', mt_log, 1, + & lx2c_moment)) lx2c_keepU = .true. + lx2c_noatm = .false. + if (rtdb_get(rtdb, 'x2c:noatm', mt_log, 1, + & lx2c_noatm)) continue + + if (lx2c_efg .and. me.eq.0) write (luout,*) + & 'x2c: will calculate EFGs, too' + + return + end + subroutine x2c_scf_terminate(rtdb, + i ipol, + g g_rel,g_x2c_u,g_x2c_u2c,g_x2c_c2u) + implicit none + integer rtdb + integer ipol + integer g_rel(*) + integer g_x2c_u(*),g_x2c_u2c,g_x2c_c2u +#include "rtdb.fh" +#include "mafdecls.fh" +#include "global.fh" +#include "stdio.fh" +#include "errquit.fh" +#include "x2c_scf.fh" +c + integer me +c deallocate x2c arrays if necessary + if (.not. ga_destroy(g_rel(1))) call errquit( + & 'dft_scf: ga_destroy failed g_rel',0, GA_ERR) + if (ipol.gt.1) then + if (.not. ga_destroy(g_rel(2))) call errquit( + & 'dft_scf: ga_destroy failed g_rel',0, GA_ERR) + end if + if (lx2c_keepU) then + if(.not.ga_destroy(g_x2c_u(1))) call errquit( + & 'dft_scf: ga_destroy failed x2c_u(1)',1, GA_ERR) + if(.not.ga_destroy(g_x2c_u(2))) call errquit( + & 'dft_scf: ga_destroy failed x2c_u(2)',2, GA_ERR) + if (lx2c_u2c) then + if(.not.ga_destroy(g_x2c_u2c)) call errquit( + & 'dft_scf: ga_destroy failed x2c_u2c',51, GA_ERR) + end if + if (lx2c_c2u) then + if(.not.ga_destroy(g_x2c_c2u)) call errquit( + & 'dft_scf: ga_destroy failed x2c_c2u',54, GA_ERR) + end if + endif + return + end + subroutine x2c_prop(rtdb, + N nexc, g_dens, g_dens_at, g_x2c_u) + implicit none + integer rtdb + integer nexc, g_dens, g_dens_at, g_x2c_u +#include "rtdb.fh" +#include "mafdecls.fh" +#include "global.fh" +#include "stdio.fh" +#include "x2c_scf.fh" +c + integer me + if (lx2c_efg) then +c x2c EFG + if (me.eq.0) + & write (luout,*) 'calling calc_x2c_efg' + call calc_x2c_efg_scalar(rtdb, + & nexc, g_dens, g_dens_at, g_x2c_u) + end if + + if (lx2c_moment) then +c x2c dipole moment + if (me.eq.0) + & write (luout,*) 'calling x2c_moment' + call calc_x2c_moment_scalar(rtdb, + & nexc, g_dens, g_dens_at, g_x2c_u, 'dipole', 3) + end if + return + end + logical function x2c_noatm() + implicit none +#include "x2c_scf.fh" + x2c_noatm=lx2c_noatm + return + end diff --git a/src/nwdft/x2c/x2c_scf.fh b/src/nwdft/x2c/x2c_scf.fh new file mode 100644 index 0000000000..3bbe11d17f --- /dev/null +++ b/src/nwdft/x2c/x2c_scf.fh @@ -0,0 +1,8 @@ + logical lx2c_efg, lx2c_moment, lx2c_hfc, lx2c_keepU + logical lx2c_c2u, lx2c_u2c, lx2c_noatm + +c + common /x2c_scf/ + & lx2c_efg, lx2c_moment, lx2c_hfc, lx2c_keepU, + & lx2c_c2u, lx2c_u2c, lx2c_noatm + From da24af09f6d47fc225594731f37c8f66e0c7ae74 Mon Sep 17 00:00:00 2001 From: edoapra Date: Wed, 13 Apr 2022 17:45:49 -0700 Subject: [PATCH 10/15] refactoring: x2c_prop --- src/nwdft/scf_dft/dft_scf.F | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/src/nwdft/scf_dft/dft_scf.F b/src/nwdft/scf_dft/dft_scf.F index c555e59e2b..0b71f6fc40 100644 --- a/src/nwdft/scf_dft/dft_scf.F +++ b/src/nwdft/scf_dft/dft_scf.F @@ -849,15 +849,6 @@ c optionally, g_x2c_c2u is also allocated and kept. & nexc, g_dens_at, g_vxc, g_rel(1), g_x2c_u, & g_x2c_u2c, g_x2c_c2u, toll_s) -c debug: print the X2C U matrices -#ifdef DEBUG - if(me.eq.0) then - write (luout,*) 'x2c U-L' - call ga_print(g_x2c_u(1)) - write (luout,*) 'x2c U-S' - call ga_print(g_x2c_u(2)) - end if ! debug -#endif if (ipol.gt.1) then if(.not.ga_duplicate(g_vxc(2),g_rel(2),'x2c 2')) @@ -1954,6 +1945,8 @@ c AOR end c ... jochen: calculate x2c properties if so requested: if (do_x2c) then + call x2c_prop(rtdb, + N nexc, g_dens, g_dens_at, g_x2c_u) end if ! do_x2c c vdw bit From b8a0f1aadf5df3737644cd3a281352fbe4285aff Mon Sep 17 00:00:00 2001 From: edoapra Date: Wed, 13 Apr 2022 18:05:19 -0700 Subject: [PATCH 11/15] cleanup --- src/nwdft/x2c/x2c_scf.F | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/src/nwdft/x2c/x2c_scf.F b/src/nwdft/x2c/x2c_scf.F index 193a12fd70..f4853a05e9 100644 --- a/src/nwdft/x2c/x2c_scf.F +++ b/src/nwdft/x2c/x2c_scf.F @@ -7,10 +7,8 @@ #include "stdio.fh" #include "x2c_scf.fh" c - integer me c check for additional x2c keywords and set c lx2c_keepU to T if we need it for any of the properties: - me=ga_nodeid() lx2c_keepU = .false. lx2c_efg = .false. if (rtdb_get(rtdb, 'x2c:efg', mt_log, 1, @@ -25,7 +23,7 @@ c lx2c_keepU to T if we need it for any of the properties: if (rtdb_get(rtdb, 'x2c:noatm', mt_log, 1, & lx2c_noatm)) continue - if (lx2c_efg .and. me.eq.0) write (luout,*) + if (lx2c_efg .and. ga_nodeid().eq.0) write (luout,*) & 'x2c: will calculate EFGs, too' return @@ -45,7 +43,6 @@ c lx2c_keepU to T if we need it for any of the properties: #include "errquit.fh" #include "x2c_scf.fh" c - integer me c deallocate x2c arrays if necessary if (.not. ga_destroy(g_rel(1))) call errquit( & 'dft_scf: ga_destroy failed g_rel',0, GA_ERR) @@ -80,10 +77,9 @@ c deallocate x2c arrays if necessary #include "stdio.fh" #include "x2c_scf.fh" c - integer me if (lx2c_efg) then c x2c EFG - if (me.eq.0) + if (ga_nodeid().eq.0) & write (luout,*) 'calling calc_x2c_efg' call calc_x2c_efg_scalar(rtdb, & nexc, g_dens, g_dens_at, g_x2c_u) @@ -91,7 +87,7 @@ c x2c EFG if (lx2c_moment) then c x2c dipole moment - if (me.eq.0) + if (ga_nodeid().eq.0) & write (luout,*) 'calling x2c_moment' call calc_x2c_moment_scalar(rtdb, & nexc, g_dens, g_dens_at, g_x2c_u, 'dipole', 3) From bfb96db88490d3e1d104c6042c36e21906c72116 Mon Sep 17 00:00:00 2001 From: edoapra Date: Wed, 13 Apr 2022 18:05:40 -0700 Subject: [PATCH 12/15] refactoring --- src/nwdft/scf_dft/dft_scf.F | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/nwdft/scf_dft/dft_scf.F b/src/nwdft/scf_dft/dft_scf.F index 0b71f6fc40..5a16d117f3 100644 --- a/src/nwdft/scf_dft/dft_scf.F +++ b/src/nwdft/scf_dft/dft_scf.F @@ -354,6 +354,8 @@ c write output about the relativistic treatment if (me.eq.0) write (luout,*) 'dft: using X2C' end if + call x2c_scf_init(rtdb) + c c !!! BGJ c Store SCF hamiltonian type as DFT for use in BGJ routines From cbfa1c62dcf7c6acda70df65b121dab0b9edcdbd Mon Sep 17 00:00:00 2001 From: edoapra Date: Wed, 13 Apr 2022 18:57:52 -0700 Subject: [PATCH 13/15] added x2c tests --- QA/doqmtests.mpi | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/QA/doqmtests.mpi b/QA/doqmtests.mpi index 6a4e6f727c..88980e680c 100755 --- a/QA/doqmtests.mpi +++ b/QA/doqmtests.mpi @@ -328,7 +328,8 @@ np_small=$(get_limit $np 16) # GW ./runtests.mpi.unix procs $np gw_closedshell ./runtests.mpi.unix procs $np gw_openshell -# +# x2c +./runtests.mpi.unix procs $np x2c-h2se #--- if we only want quick tests get out now! if [[ "$what" == "fast" ]]; then exit From 1c51321468878bcbb9c7da23cdb2387367920cf7 Mon Sep 17 00:00:00 2001 From: edoapra Date: Wed, 13 Apr 2022 19:25:23 -0700 Subject: [PATCH 14/15] removed memory line --- QA/tests/x2c-h2se/x2c-h2se.nw | 1 - 1 file changed, 1 deletion(-) diff --git a/QA/tests/x2c-h2se/x2c-h2se.nw b/QA/tests/x2c-h2se/x2c-h2se.nw index b0e8924c13..e55b3df5eb 100644 --- a/QA/tests/x2c-h2se/x2c-h2se.nw +++ b/QA/tests/x2c-h2se/x2c-h2se.nw @@ -2,7 +2,6 @@ echo start testjob title efgjob -memory total 2000 mb stack 1000 mb geometry noautoz units bohr nocenter symmetry c1 From 153862f8e6794416d651d37a5346c4485b093af9 Mon Sep 17 00:00:00 2001 From: edoapra Date: Wed, 13 Apr 2022 19:25:54 -0700 Subject: [PATCH 15/15] added x2c test --- travis/run_qas.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/travis/run_qas.sh b/travis/run_qas.sh index 15766a8f29..69d5462a64 100755 --- a/travis/run_qas.sh +++ b/travis/run_qas.sh @@ -157,6 +157,7 @@ fi cd $TRAVIS_BUILD_DIR/QA && ./runtests.mpi.unix procs $nprocs dft_he2p_wb97 cd $TRAVIS_BUILD_DIR/QA && ./runtests.mpi.unix procs $nprocs ritddft_pyridine cd $TRAVIS_BUILD_DIR/QA && ./runtests.mpi.unix procs $nprocs au2-sarc-zora-mp + cd $TRAVIS_BUILD_DIR/QA && ./runtests.mpi.unix procs $nprocs x2c-h2se if [[ ! -z "$USE_LIBXC" ]]; then cd $TRAVIS_BUILD_DIR/QA && ./runtests.mpi.unix procs $nprocs libxc_he2+ fi