Skip to content

Commit

Permalink
grid: Merge idir and ir into ga_gb_function argument
Browse files Browse the repository at this point in the history
  • Loading branch information
@oschuett
oschuett committed Feb 14, 2020
1 parent e4387f1 commit 9f75210
Show file tree
Hide file tree
Showing 3 changed files with 184 additions and 124 deletions.
72 changes: 41 additions & 31 deletions src/grid/grid_collocate.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,20 +33,32 @@ MODULE grid_collocate

PUBLIC :: collocate_pgf_product

INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_AB = 401
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DADB = 402
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ADBmDAB = 403
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ARDBmDARB = 404
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DABpADB = 405
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DXDY = 601
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DYDZ = 602
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DZDX = 603
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DXDX = 604
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DYDY = 605
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DZDZ = 606
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DX = 501
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DY = 502
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DZ = 503
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_AB = 100
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DADB = 200
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ADBmDAB_X = 301
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ADBmDAB_Y = 302
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ADBmDAB_Z = 303
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ARDBmDARB_XX = 411
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ARDBmDARB_XY = 412
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ARDBmDARB_XZ = 413
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ARDBmDARB_YX = 421
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ARDBmDARB_YY = 422
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ARDBmDARB_YZ = 423
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ARDBmDARB_ZX = 431
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ARDBmDARB_ZY = 432
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_ARDBmDARB_ZZ = 433
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DABpADB_X = 501
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DABpADB_Y = 502
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DABpADB_Z = 503
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DX = 601
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DY = 602
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DZ = 603
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DXDY = 701
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DYDZ = 702
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DZDX = 703
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DXDX = 801
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DYDY = 802
INTEGER, PARAMETER, PUBLIC :: GRID_FUNC_DZDZ = 803

CONTAINS

Expand All @@ -69,8 +81,6 @@ MODULE grid_collocate
!> \param cube_info ...
!> \param ga_gb_function ...
!> \param radius ...
!> \param idir ...
!> \param ir ...
!> \param use_subpatch ...
!> \param subpatch_pattern ...
!> \param lmax_global Maximum possible value of lmax used to dimension arrays
Expand All @@ -79,8 +89,7 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
lb_max, zetb, lb_min, &
ra, rab, scale, pab, o1, o2, &
rsgrid, cell, cube_info, &
ga_gb_function, &
radius, idir, ir, &
ga_gb_function, radius, &
use_subpatch, subpatch_pattern, &
lmax_global)

Expand All @@ -98,7 +107,6 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
TYPE(cube_info_type), INTENT(IN) :: cube_info
REAL(KIND=dp), INTENT(IN) :: radius
INTEGER, INTENT(IN) :: ga_gb_function
INTEGER, INTENT(IN), OPTIONAL :: idir, ir
LOGICAL, OPTIONAL :: use_subpatch
INTEGER(KIND=int_8), OPTIONAL, INTENT(IN):: subpatch_pattern
INTEGER, INTENT(IN) :: lmax_global
Expand All @@ -109,7 +117,7 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
INTEGER :: cmax, gridbounds(2, 3), i, ico, icoef, ider1, ider2, ig, &
jco, k, l, la_max_local, la_min_local, lb_max_local, lb_min_local, &
length, lxa, lxb, lxy, lxyz, lya, lyb, &
lza, lzb, o1_local, o2_local, offset, start
lza, lzb, o1_local, o2_local, offset, start, idir, ir
INTEGER, DIMENSION(3) :: cubecenter, lb_cube, ng, &
ub_cube
INTEGER, DIMENSION(:), POINTER :: sphere_bounds
Expand Down Expand Up @@ -191,8 +199,8 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
o1_local = 0
o2_local = 0
pab_local = pab_local*0.5_dp
CASE (GRID_FUNC_ADBmDAB)
CPASSERT(PRESENT(idir))
CASE (GRID_FUNC_ADBmDAB_X, GRID_FUNC_ADBmDAB_Y, GRID_FUNC_ADBmDAB_Z)
idir = MODULO(ga_gb_function, 10)
la_max_local = la_max + 1
la_min_local = MAX(la_min - 1, 0)
lb_max_local = lb_max + 1
Expand Down Expand Up @@ -223,8 +231,8 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
END DO
o1_local = 0
o2_local = 0
CASE (GRID_FUNC_DABpADB)
CPASSERT(PRESENT(idir))
CASE (GRID_FUNC_DABpADB_X, GRID_FUNC_DABpADB_Y, GRID_FUNC_DABpADB_Z)
idir = MODULO(ga_gb_function, 10)
la_max_local = la_max + 1
la_min_local = MAX(la_min - 1, 0)
lb_max_local = lb_max + 1
Expand Down Expand Up @@ -256,7 +264,7 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
o1_local = 0
o2_local = 0
CASE (GRID_FUNC_DX, GRID_FUNC_DY, GRID_FUNC_DZ)
ider1 = ga_gb_function - 500
ider1 = MODULO(ga_gb_function, 10)
la_max_local = la_max + 1
la_min_local = MAX(la_min - 1, 0)
lb_max_local = lb_max + 1
Expand Down Expand Up @@ -288,8 +296,8 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
o1_local = 0
o2_local = 0
CASE (GRID_FUNC_DXDY, GRID_FUNC_DYDZ, GRID_FUNC_DZDX)
ider1 = ga_gb_function - 600
ider2 = ga_gb_function - 600 + 1
ider1 = MODULO(ga_gb_function, 10)
ider2 = ider1 + 1
IF (ider2 > 3) ider2 = ider1 - 2
la_max_local = la_max + 2
la_min_local = MAX(la_min - 2, 0)
Expand Down Expand Up @@ -318,7 +326,7 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
o1_local = 0
o2_local = 0
CASE (GRID_FUNC_DXDX, GRID_FUNC_DYDY, GRID_FUNC_DZDZ)
ider1 = ga_gb_function - 603
ider1 = MODULO(ga_gb_function, 10)
la_max_local = la_max + 2
la_min_local = MAX(la_min - 2, 0)
lb_max_local = lb_max + 2
Expand Down Expand Up @@ -346,9 +354,11 @@ SUBROUTINE collocate_pgf_product(la_max, zeta, la_min, &
END DO
o1_local = 0
o2_local = 0
CASE (GRID_FUNC_ARDBmDARB)
CPASSERT(PRESENT(idir))
CPASSERT(PRESENT(ir))
CASE (GRID_FUNC_ARDBmDARB_XX, GRID_FUNC_ARDBmDARB_XY, GRID_FUNC_ARDBmDARB_XZ, &
GRID_FUNC_ARDBmDARB_YX, GRID_FUNC_ARDBmDARB_YY, GRID_FUNC_ARDBmDARB_YZ, &
GRID_FUNC_ARDBmDARB_ZX, GRID_FUNC_ARDBmDARB_ZY, GRID_FUNC_ARDBmDARB_ZZ)
ir = MODULO(ga_gb_function, 10)
idir = MODULO(ga_gb_function - ir, 100)/10
la_max_local = la_max + 1
la_min_local = MAX(la_min - 1, 0)
lb_max_local = lb_max + 2
Expand Down
156 changes: 81 additions & 75 deletions src/qs_collocate_density.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,9 +56,10 @@ MODULE qs_collocate_density
USE gaussian_gridlevels, ONLY: gaussian_gridlevel,&
gridlevel_info_type
USE grid_collocate, ONLY: &
GRID_FUNC_AB, GRID_FUNC_ADBmDAB, GRID_FUNC_ARDBmDARB, GRID_FUNC_DABpADB, GRID_FUNC_DADB, &
GRID_FUNC_DX, GRID_FUNC_DXDX, GRID_FUNC_DXDY, GRID_FUNC_DY, GRID_FUNC_DYDY, &
GRID_FUNC_DYDZ, GRID_FUNC_DZ, GRID_FUNC_DZDX, GRID_FUNC_DZDZ, collocate_pgf_product
GRID_FUNC_AB, GRID_FUNC_DABpADB_X, GRID_FUNC_DABpADB_Y, GRID_FUNC_DABpADB_Z, &
GRID_FUNC_DADB, GRID_FUNC_DX, GRID_FUNC_DXDX, GRID_FUNC_DXDY, GRID_FUNC_DY, &
GRID_FUNC_DYDY, GRID_FUNC_DYDZ, GRID_FUNC_DZ, GRID_FUNC_DZDX, GRID_FUNC_DZDZ, &
collocate_pgf_product
USE input_constants, ONLY: &
orb_dx2, orb_dxy, orb_dy2, orb_dyz, orb_dz2, orb_dzx, orb_px, orb_py, orb_pz, orb_s
USE kinds, ONLY: default_string_length,&
Expand Down Expand Up @@ -1490,8 +1491,8 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho,
INTEGER :: bcol, brow, ga_gb_function, handle, iatom, iatom_old, igrid_level, ikind, &
ikind_old, img, img_old, ipair, ipgf, iset, iset_old, itask, ithread, jatom, jatom_old, &
jkind, jkind_old, jpgf, jset, jset_old, lb, lbr, lbw, lmax_global, maxco, maxpgf, maxset, &
maxsgf, maxsgf_set, my_idir, n, na1, na2, natoms, nb1, nb2, nblock, ncoa, ncob, nimages, &
nr, nrlevel, nseta, nsetb, ntasks, nthread, nw, nxy, nz, nzsize, sgfa, sgfb, ub
maxsgf, maxsgf_set, n, na1, na2, natoms, nb1, nb2, nblock, ncoa, ncob, nimages, nr, &
nrlevel, nseta, nsetb, ntasks, nthread, nw, nxy, nz, nzsize, sgfa, sgfb, ub
INTEGER(kind=int_8), DIMENSION(:), POINTER :: atom_pair_recv, atom_pair_send
INTEGER, DIMENSION(:), POINTER :: la_max, la_min, lb_max, lb_min, mylmax, &
npgfa, npgfb, nsgfa, nsgfb
Expand Down Expand Up @@ -1554,42 +1555,6 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho,
my_compute_grad = .FALSE.
ENDIF

my_idir = 0
IF (PRESENT(der_type)) THEN
SELECT CASE (der_type)
CASE (orb_s)
ga_gb_function = GRID_FUNC_AB
CASE (orb_px)
ga_gb_function = GRID_FUNC_DX
CASE (orb_py)
ga_gb_function = GRID_FUNC_DY
CASE (orb_pz)
ga_gb_function = GRID_FUNC_DZ
CASE (orb_dxy)
ga_gb_function = GRID_FUNC_DXDY
CASE (orb_dyz)
ga_gb_function = GRID_FUNC_DYDZ
CASE (orb_dzx)
ga_gb_function = GRID_FUNC_DZDX
CASE (orb_dx2)
ga_gb_function = GRID_FUNC_DXDX
CASE (orb_dy2)
ga_gb_function = GRID_FUNC_DYDY
CASE (orb_dz2)
ga_gb_function = GRID_FUNC_DZDZ
CASE DEFAULT
CPABORT("Unknown der_type")
END SELECT

ELSE IF (my_compute_tau) THEN
ga_gb_function = GRID_FUNC_DADB
ELSE IF (my_compute_grad) THEN
ga_gb_function = GRID_FUNC_DABpADB
ELSE
ga_gb_function = GRID_FUNC_AB
ENDIF
IF (PRESENT(idir)) my_idir = idir

IF (PRESENT(basis_type)) THEN
my_basis_type = basis_type
ELSE
Expand Down Expand Up @@ -1654,28 +1619,63 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho,
lmax_global = MAX(MAXVAL(mylmax), lmax_global)
END DO

! Optionally increment lmax_global depending on which ga_gb_function
! will be used for collocation
SELECT CASE (ga_gb_function)
CASE (GRID_FUNC_DADB)
lmax_global = lmax_global + 1
CASE (GRID_FUNC_ADBmDAB)
lmax_global = lmax_global + 1
CASE (GRID_FUNC_DABpADB)
lmax_global = lmax_global + 1
CASE (GRID_FUNC_DX, GRID_FUNC_DY, GRID_FUNC_DZ)
! Select ga_gb_function and increment lmax_global if needed.
IF (PRESENT(der_type)) THEN
SELECT CASE (der_type)
CASE (orb_s)
ga_gb_function = GRID_FUNC_AB
lmax_global = lmax_global + 1
CASE (orb_px)
ga_gb_function = GRID_FUNC_DX
lmax_global = lmax_global + 1
CASE (orb_py)
ga_gb_function = GRID_FUNC_DY
lmax_global = lmax_global + 1
CASE (orb_pz)
ga_gb_function = GRID_FUNC_DZ
lmax_global = lmax_global + 1
CASE (orb_dxy)
ga_gb_function = GRID_FUNC_DXDY
lmax_global = lmax_global + 2
CASE (orb_dyz)
ga_gb_function = GRID_FUNC_DYDZ
lmax_global = lmax_global + 2
CASE (orb_dzx)
ga_gb_function = GRID_FUNC_DZDX
lmax_global = lmax_global + 2
CASE (orb_dx2)
ga_gb_function = GRID_FUNC_DXDX
lmax_global = lmax_global + 2
CASE (orb_dy2)
ga_gb_function = GRID_FUNC_DYDY
lmax_global = lmax_global + 2
CASE (orb_dz2)
ga_gb_function = GRID_FUNC_DZDZ
lmax_global = lmax_global + 2
CASE DEFAULT
CPABORT("Unknown der_type")
END SELECT
ELSE IF (my_compute_tau) THEN
ga_gb_function = GRID_FUNC_DADB
lmax_global = lmax_global + 1
CASE (GRID_FUNC_DXDY, GRID_FUNC_DYDZ, GRID_FUNC_DZDX)
lmax_global = lmax_global + 2
CASE (GRID_FUNC_DXDX, GRID_FUNC_DYDY, GRID_FUNC_DZDZ)
lmax_global = lmax_global + 2
CASE (GRID_FUNC_ARDBmDARB)
lmax_global = lmax_global + 2
CASE (GRID_FUNC_AB)
lmax_global = lmax_global
CASE DEFAULT
CPABORT("unknown ga_gb_function")
END SELECT
ELSE IF (my_compute_grad) THEN
CPASSERT(PRESENT(idir))
SELECT CASE (idir)
CASE (1)
ga_gb_function = GRID_FUNC_DABpADB_X
lmax_global = lmax_global + 1
CASE (2)
ga_gb_function = GRID_FUNC_DABpADB_Y
lmax_global = lmax_global + 1
CASE (3)
ga_gb_function = GRID_FUNC_DABpADB_Z
lmax_global = lmax_global + 1
CASE DEFAULT
CPABORT("invalid idir")
END SELECT
ELSE
ga_gb_function = GRID_FUNC_AB
ENDIF

! get the task lists
IF (my_soft) task_list => task_list_soft
Expand Down Expand Up @@ -1748,7 +1748,7 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho,
!$OMP PARALLEL DEFAULT(NONE), &
!$OMP SHARED(ntasks,tasks,nimages,natoms,maxset,maxpgf,particle_set,pabt,workt), &
!$OMP SHARED(my_basis_type,my_soft,deltap,maxco,ncoset,nthread), &
!$OMP SHARED(cell,cube_info,eps_rho_rspace,ga_gb_function, my_idir), &
!$OMP SHARED(cell,cube_info,eps_rho_rspace,ga_gb_function), &
!$OMP SHARED(rs_rho,lgrid,gridlevel_info,task_list,qs_kind_set,lmax_global), &
!$OMP PRIVATE(igrid_level,iatom,jatom,iset,jset,ipgf,jpgf,ikind,jkind,pab,work), &
!$OMP PRIVATE(img,img_old,iatom_old,jatom_old,iset_old,jset_old,ikind_old,jkind_old), &
Expand Down Expand Up @@ -1921,7 +1921,6 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho,
threadlocal_rsgrid, cell, cube_info(igrid_level), &
radius=radius, &
ga_gb_function=ga_gb_function, &
idir=my_idir, &
use_subpatch=use_subpatch, &
subpatch_pattern=tasks(itask)%subpatch_pattern, lmax_global=lmax_global)
ELSE
Expand All @@ -1933,7 +1932,6 @@ SUBROUTINE calculate_rho_elec(matrix_p, matrix_p_kp, rho, rho_gspace, total_rho,
threadlocal_rsgrid, cell, cube_info(igrid_level), &
radius=radius, &
ga_gb_function=ga_gb_function, &
idir=my_idir, &
use_subpatch=use_subpatch, &
subpatch_pattern=tasks(itask)%subpatch_pattern, lmax_global=lmax_global)
END IF
Expand Down Expand Up @@ -2036,10 +2034,10 @@ SUBROUTINE calculate_drho_elec(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env,
routineP = moduleN//':'//routineN

CHARACTER(LEN=default_string_length) :: my_basis_type
INTEGER :: bcol, brow, handle, i, iatom, iatom_old, idir, igrid_level, ikind, ikind_old, &
img, img_old, ipgf, iset, iset_old, itask, ithread, jatom, jatom_old, jkind, jkind_old, &
jpgf, jset, jset_old, lmax_global, maxco, maxpgf, maxset, maxsgf, maxsgf_set, na1, na2, &
natoms, nb1, nb2, ncoa, ncob, nimages, nseta, nsetb, ntasks, nthread, sgfa, sgfb
INTEGER :: bcol, brow, dabqadb_func, handle, i, iatom, iatom_old, idir, igrid_level, ikind, &
ikind_old, img, img_old, ipgf, iset, iset_old, itask, ithread, jatom, jatom_old, jkind, &
jkind_old, jpgf, jset, jset_old, lmax_global, maxco, maxpgf, maxset, maxsgf, maxsgf_set, &
na1, na2, natoms, nb1, nb2, ncoa, ncob, nimages, nseta, nsetb, ntasks, nthread, sgfa, sgfb
INTEGER(kind=int_8), DIMENSION(:), POINTER :: atom_pair_recv, atom_pair_send
INTEGER, DIMENSION(:), POINTER :: la_max, la_min, lb_max, lb_min, mylmax, &
npgfa, npgfb, nsgfa, nsgfb
Expand Down Expand Up @@ -2360,15 +2358,25 @@ SUBROUTINE calculate_drho_elec(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env,
ELSE
use_subpatch = .FALSE.
ENDIF
SELECT CASE (idir)
CASE (1)
dabqadb_func = GRID_FUNC_DABpADB_X
CASE (2)
dabqadb_func = GRID_FUNC_DABpADB_Y
CASE (3)
dabqadb_func = GRID_FUNC_DABpADB_Z
CASE DEFAULT
CPABORT("invalid idir")
END SELECT
IF (iatom <= jatom) THEN
CALL collocate_pgf_product( &
la_max(iset), zeta(ipgf, iset), la_min(iset), &
lb_max(jset), zetb(jpgf, jset), lb_min(jset), &
ra, rab, scale, pab, na1 - 1, nb1 - 1, &
rs_rho(igrid_level)%rs_grid, cell, cube_info(igrid_level), &
radius=radius, &
ga_gb_function=GRID_FUNC_DABpADB, &
idir=idir, &
radius=radius, ga_gb_function=dabqadb_func, &
use_subpatch=use_subpatch, subpatch_pattern=tasks(itask)%subpatch_pattern, &
lmax_global=lmax_global)
ELSE
Expand All @@ -2378,9 +2386,7 @@ SUBROUTINE calculate_drho_elec(matrix_p, matrix_p_kp, drho, drho_gspace, qs_env,
la_max(iset), zeta(ipgf, iset), la_min(iset), &
rb, rab_inv, scale, pab, nb1 - 1, na1 - 1, &
rs_rho(igrid_level)%rs_grid, cell, cube_info(igrid_level), &
radius=radius, &
ga_gb_function=GRID_FUNC_DABpADB, &
idir=idir, &
radius=radius, ga_gb_function=dabqadb_func, &
use_subpatch=use_subpatch, subpatch_pattern=tasks(itask)%subpatch_pattern, &
lmax_global=lmax_global)
END IF
Expand Down

0 comments on commit 9f75210

Please sign in to comment.