12 USE dbcsr_api,
ONLY: dbcsr_create,&
13 dbcsr_distribution_type,&
16 dbcsr_get_stored_coordinates,&
19 dbcsr_type_no_symmetry
30 fb_atomic_halo_list_obj,&
57 #include "./base/base_uses.f90"
63 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_fb_filter_matrix_methods'
104 TYPE(dbcsr_type),
POINTER :: h_mat, s_mat
105 TYPE(fb_atomic_halo_list_obj),
INTENT(IN) :: atomic_halos
106 TYPE(fb_trial_fns_obj),
INTENT(IN) :: trial_fns
107 TYPE(mp_para_env_type),
POINTER :: para_env
108 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
109 REAL(kind=
dp),
INTENT(IN) :: fermi_level, filter_temp
110 CHARACTER(LEN=*),
INTENT(IN) :: name
111 TYPE(dbcsr_type),
POINTER :: filter_mat
112 REAL(kind=
dp),
INTENT(IN) :: tolerance
114 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fb_fltrmat_build'
116 CHARACTER(LEN=32) :: symmetry_string
117 CHARACTER(LEN=default_string_length) :: name_string
118 INTEGER :: handle, iblkcol, ihalo, ikind, &
119 max_nhalos, nblkcols_total, nhalos
120 INTEGER,
DIMENSION(:),
POINTER :: col_blk_size, dummy_halo_atoms, ntfns, &
122 LOGICAL :: send_data_only
123 TYPE(atomic_kind_type),
POINTER :: atomic_kind
124 TYPE(dbcsr_distribution_type) :: dbcsr_dist
125 TYPE(fb_atomic_halo_obj) :: dummy_atomic_halo
126 TYPE(fb_atomic_halo_obj),
DIMENSION(:),
POINTER :: halos
128 CALL timeset(routinen, handle)
130 NULLIFY (halos, atomic_kind, ntfns, dummy_halo_atoms, row_blk_size, col_blk_size)
134 cpassert(.NOT.
ASSOCIATED(filter_mat))
143 CALL dbcsr_get_info(h_mat, &
144 nblkcols_total=nblkcols_total, &
145 row_blk_size=row_blk_size, &
146 distribution=dbcsr_dist)
147 ALLOCATE (col_blk_size(nblkcols_total))
149 DO iblkcol = 1, nblkcols_total
150 atomic_kind => particle_set(iblkcol)%atomic_kind
153 col_blk_size(iblkcol) = ntfns(ikind)
160 symmetry_string = dbcsr_type_no_symmetry
162 ALLOCATE (filter_mat)
163 CALL dbcsr_create(matrix=filter_mat, &
166 matrix_type=symmetry_string, &
167 row_blk_size=row_blk_size, &
168 col_blk_size=col_blk_size, &
170 DEALLOCATE (col_blk_size)
174 max_nhalos=max_nhalos, &
179 ALLOCATE (dummy_halo_atoms(0))
182 owner_id_in_halo=0, &
184 halo_atoms=dummy_halo_atoms, &
188 send_data_only = .false.
190 DO ihalo = 1, max_nhalos
191 IF (ihalo > nhalos)
THEN
192 send_data_only = .true.
195 IF (send_data_only)
THEN
196 CALL fb_fltrmat_add_blkcol(h_mat, &
207 CALL fb_fltrmat_add_blkcol(h_mat, &
221 CALL dbcsr_finalize(filter_mat)
226 CALL timestop(handle)
264 TYPE(dbcsr_type),
POINTER :: h_mat, s_mat
265 TYPE(fb_atomic_halo_list_obj),
INTENT(IN) :: atomic_halos
266 TYPE(fb_trial_fns_obj),
INTENT(IN) :: trial_fns
267 TYPE(mp_para_env_type),
POINTER :: para_env
268 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
269 REAL(kind=
dp),
INTENT(IN) :: fermi_level, filter_temp
270 CHARACTER(LEN=*),
INTENT(IN) :: name
271 TYPE(dbcsr_type),
POINTER :: filter_mat
272 REAL(kind=
dp),
INTENT(IN) :: tolerance
274 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fb_fltrmat_build_2'
276 CHARACTER(LEN=default_string_length) :: name_string
277 INTEGER :: handle, iblkcol, ihalo, ikind, &
278 natoms_global, natoms_in_halo, &
279 nblkcols_total, nblks_recv, nhalos, &
281 INTEGER,
DIMENSION(:),
POINTER :: col_blk_size, ntfns, row_blk_size
283 TYPE(atomic_kind_type),
POINTER :: atomic_kind
284 TYPE(dbcsr_distribution_type) :: dbcsr_dist
285 TYPE(fb_atomic_halo_obj),
DIMENSION(:),
POINTER :: halos
286 TYPE(fb_com_atom_pairs_obj) :: atmatrix_blks_recv, atmatrix_blks_send, &
287 filter_mat_blks_recv, &
289 TYPE(fb_matrix_data_obj) :: filter_mat_data, h_mat_data, s_mat_data
291 CALL timeset(routinen, handle)
293 NULLIFY (halos, atomic_kind, row_blk_size, col_blk_size, ntfns)
296 check_ok = .NOT.
ASSOCIATED(filter_mat)
300 natoms_global =
SIZE(particle_set)
309 CALL dbcsr_get_info(h_mat, &
310 nblkcols_total=nblkcols_total, &
311 row_blk_size=row_blk_size, &
312 distribution=dbcsr_dist)
313 ALLOCATE (col_blk_size(nblkcols_total))
315 DO iblkcol = 1, nblkcols_total
316 atomic_kind => particle_set(iblkcol)%atomic_kind
319 col_blk_size(iblkcol) = ntfns(ikind)
326 ALLOCATE (filter_mat)
327 CALL dbcsr_create(matrix=filter_mat, &
330 matrix_type=dbcsr_type_no_symmetry, &
331 row_blk_size=row_blk_size, &
332 col_blk_size=col_blk_size, &
334 DEALLOCATE (col_blk_size)
348 atmatrix_blks_send, &
356 atmatrix_blks_send, &
357 atmatrix_blks_recv, &
364 atmatrix_blks_send, &
372 atmatrix_blks_send, &
373 atmatrix_blks_recv, &
389 natoms=natoms_in_halo)
390 nmax = nmax + natoms_in_halo
396 CALL fb_fltrmat_add_blkcol_2(h_mat, &
418 CALL fb_fltrmat_generate_com_pairs_2(filter_mat, &
421 filter_mat_blks_send, &
422 filter_mat_blks_recv)
424 filter_mat_blks_send, &
425 filter_mat_blks_recv, &
434 CALL dbcsr_finalize(filter_mat)
436 CALL timestop(handle)
461 SUBROUTINE fb_fltrmat_add_blkcol(H_mat, &
471 TYPE(dbcsr_type),
POINTER :: h_mat, s_mat
472 TYPE(fb_atomic_halo_obj),
INTENT(IN) :: atomic_halo
473 TYPE(fb_trial_fns_obj),
INTENT(IN) :: trial_fns
474 TYPE(mp_para_env_type),
POINTER :: para_env
475 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
476 REAL(kind=
dp),
INTENT(IN) :: fermi_level, filter_temp
477 TYPE(dbcsr_type),
POINTER :: filter_mat
478 REAL(kind=
dp),
INTENT(IN) :: tolerance
480 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fb_fltrmat_add_blkcol'
482 INTEGER :: handle, handle_mpi, iatom_global, iatom_in_halo, ind, ipair, ipe, itrial, &
483 jatom_global, jatom_in_halo, jkind, natoms_global, natoms_in_halo, ncols_atmatrix, &
484 ncols_blk, nrows_atmatrix, nrows_blk, numprocs, pe, recv_encode, send_encode, stat
485 INTEGER(KIND=int_8),
DIMENSION(:),
POINTER :: pairs_recv, pairs_send
486 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: atomic_h_blk_col_start, atomic_h_blk_row_start, &
487 atomic_s_blk_col_start, atomic_s_blk_row_start, col_block_size_data, ind_in_halo, &
488 recv_disps, recv_pair_count, recv_pair_disps, recv_sizes, send_disps, send_pair_count, &
489 send_pair_disps, send_sizes
490 INTEGER,
DIMENSION(:),
POINTER :: halo_atoms, ntfns, row_block_size_data
491 INTEGER,
DIMENSION(:, :),
POINTER :: tfns
492 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: recv_buf, send_buf
493 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: atomic_filter_mat, atomic_h, atomic_s
494 TYPE(atomic_kind_type),
POINTER :: atomic_kind
495 TYPE(fb_com_atom_pairs_obj) :: com_pairs_recv, com_pairs_send
497 CALL timeset(routinen, handle)
499 NULLIFY (atomic_kind, halo_atoms, ntfns, pairs_send, pairs_recv, &
500 row_block_size_data, tfns)
511 CALL fb_fltrmat_generate_com_pairs(filter_mat, &
517 natoms_encode=send_encode, &
520 natoms_encode=recv_encode, &
524 numprocs = para_env%num_pe
533 CALL dbcsr_get_info(h_mat, row_blk_size=row_block_size_data)
534 natoms_global =
SIZE(particle_set)
535 ALLOCATE (col_block_size_data(natoms_global))
536 DO jatom_global = 1, natoms_global
537 atomic_kind => particle_set(jatom_global)%atomic_kind
539 col_block_size_data(jatom_global) = ntfns(jkind)
543 ALLOCATE (send_sizes(numprocs))
544 ALLOCATE (send_disps(numprocs))
545 ALLOCATE (send_pair_count(numprocs))
546 ALLOCATE (send_pair_disps(numprocs))
550 row_block_size_data, &
551 col_block_size_data, &
557 ALLOCATE (send_buf(sum(send_sizes)))
560 ALLOCATE (recv_sizes(numprocs))
561 ALLOCATE (recv_disps(numprocs))
562 ALLOCATE (recv_pair_count(numprocs))
563 ALLOCATE (recv_pair_disps(numprocs))
567 row_block_size_data, &
568 col_block_size_data, &
574 ALLOCATE (recv_buf(sum(recv_sizes)))
581 natoms=natoms_in_halo, &
582 halo_atoms=halo_atoms)
585 ALLOCATE (atomic_h_blk_row_start(natoms_in_halo + 1), &
586 atomic_h_blk_col_start(natoms_in_halo + 1), &
593 atomic_h_blk_row_start, &
594 atomic_h_blk_col_start)
596 ALLOCATE (atomic_h(nrows_atmatrix, ncols_atmatrix))
601 atomic_h_blk_row_start, &
602 atomic_h_blk_col_start)
605 ALLOCATE (atomic_s_blk_row_start(natoms_in_halo + 1), &
606 atomic_s_blk_col_start(natoms_in_halo + 1), &
613 atomic_s_blk_row_start, &
614 atomic_s_blk_col_start)
615 ALLOCATE (atomic_s(nrows_atmatrix, ncols_atmatrix))
620 atomic_s_blk_row_start, &
621 atomic_s_blk_col_start)
624 ALLOCATE (atomic_filter_mat(nrows_atmatrix, ncols_atmatrix))
626 IF (nrows_atmatrix > 0 .AND. ncols_atmatrix > 0)
THEN
627 CALL fb_fltrmat_build_atomic_fltrmat(atomic_h, &
641 ALLOCATE (ind_in_halo(natoms_global))
643 DO iatom_in_halo = 1, natoms_in_halo
644 iatom_global = halo_atoms(iatom_in_halo)
645 ind_in_halo(iatom_global) = iatom_in_halo
649 IF (
SIZE(send_buf) > 0) send_buf = 0.0_dp
653 DO ipair = 1, send_pair_count(ipe)
655 pe, iatom_global, jatom_global, &
657 iatom_in_halo = ind_in_halo(iatom_global)
658 cpassert(iatom_in_halo > 0)
659 jatom_in_halo = ind_in_halo(jatom_global)
660 cpassert(jatom_in_halo > 0)
661 atomic_kind => particle_set(jatom_global)%atomic_kind
664 nrows_blk = row_block_size_data(iatom_global)
665 ncols_blk = ntfns(jkind)
668 DO itrial = 1, ntfns(jkind)
669 ind = send_disps(ipe) + send_sizes(ipe) + (itrial - 1)*nrows_blk
675 atomic_h_blk_row_start(iatom_in_halo): &
676 atomic_h_blk_row_start(iatom_in_halo + 1) - 1, &
682 atomic_s_blk_col_start(jatom_in_halo) + &
683 tfns(itrial, jkind) - 1 &
687 send_buf(ind + 1:ind + nrows_blk), &
690 send_sizes(ipe) = send_sizes(ipe) + nrows_blk*ncols_blk
694 DEALLOCATE (atomic_h)
695 DEALLOCATE (atomic_h_blk_row_start)
696 DEALLOCATE (atomic_s)
697 DEALLOCATE (atomic_s_blk_row_start)
698 DEALLOCATE (atomic_filter_mat)
699 DEALLOCATE (ind_in_halo)
705 CALL timeset(
"fb_fltrmat_add_blkcol_mpi", handle_mpi)
707 CALL para_env%alltoall(send_buf, send_sizes, send_disps, &
708 recv_buf, recv_sizes, recv_disps)
710 CALL timestop(handle_mpi)
712 DEALLOCATE (send_buf)
713 DEALLOCATE (send_sizes)
714 DEALLOCATE (send_disps)
715 DEALLOCATE (send_pair_count)
716 DEALLOCATE (send_pair_disps)
725 DO ipair = 1, recv_pair_count(ipe)
727 pe, iatom_global, jatom_global, &
729 nrows_blk = row_block_size_data(iatom_global)
730 ncols_blk = col_block_size_data(jatom_global)
731 ind = recv_disps(ipe) + recv_sizes(ipe)
732 CALL dbcsr_put_block(filter_mat, &
733 iatom_global, jatom_global, &
734 recv_buf((ind + 1):(ind + nrows_blk*ncols_blk)))
735 recv_sizes(ipe) = recv_sizes(ipe) + nrows_blk*ncols_blk
740 DEALLOCATE (recv_buf)
741 DEALLOCATE (recv_sizes)
742 DEALLOCATE (recv_pair_count)
743 DEALLOCATE (recv_pair_disps)
750 CALL timestop(handle)
752 END SUBROUTINE fb_fltrmat_add_blkcol
775 SUBROUTINE fb_fltrmat_add_blkcol_2(H_mat, &
786 TYPE(dbcsr_type),
POINTER :: h_mat, s_mat
787 TYPE(fb_matrix_data_obj),
INTENT(IN) :: h_mat_data, s_mat_data
788 TYPE(fb_atomic_halo_obj),
INTENT(IN) :: atomic_halo
789 TYPE(fb_trial_fns_obj),
INTENT(IN) :: trial_fns
790 TYPE(particle_type),
DIMENSION(:),
POINTER :: particle_set
791 REAL(kind=
dp),
INTENT(IN) :: fermi_level, filter_temp
792 TYPE(fb_matrix_data_obj),
INTENT(INOUT) :: filter_mat_data
793 REAL(kind=
dp),
INTENT(IN) :: tolerance
795 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fb_fltrmat_add_blkcol_2'
797 INTEGER :: handle, iatom_global, iatom_in_halo, itrial, jatom_global, jatom_in_halo, jkind, &
798 natoms_global, natoms_in_halo, ncols_atmatrix, ncols_blk, ncols_blk_max, nrows_atmatrix, &
799 nrows_blk, nrows_blk_max, stat
800 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: atomic_h_blk_col_start, atomic_h_blk_row_start, &
801 atomic_s_blk_col_start, atomic_s_blk_row_start, col_block_size_data
802 INTEGER,
DIMENSION(:),
POINTER :: halo_atoms, ntfns, row_block_size_data
803 INTEGER,
DIMENSION(:, :),
POINTER :: tfns
805 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: atomic_filter_mat, atomic_h, atomic_s, &
807 TYPE(atomic_kind_type),
POINTER :: atomic_kind
809 CALL timeset(routinen, handle)
811 NULLIFY (atomic_kind, halo_atoms, ntfns, row_block_size_data, tfns)
824 CALL dbcsr_get_info(h_mat, row_blk_size=row_block_size_data)
825 natoms_global =
SIZE(particle_set)
826 ALLOCATE (col_block_size_data(natoms_global))
827 DO jatom_global = 1, natoms_global
828 atomic_kind => particle_set(jatom_global)%atomic_kind
830 col_block_size_data(jatom_global) = ntfns(jkind)
838 natoms=natoms_in_halo, &
839 halo_atoms=halo_atoms)
842 ALLOCATE (atomic_h_blk_row_start(natoms_in_halo + 1), &
843 atomic_h_blk_col_start(natoms_in_halo + 1), &
850 atomic_h_blk_row_start, &
851 atomic_h_blk_col_start)
852 ALLOCATE (atomic_h(nrows_atmatrix, ncols_atmatrix))
856 atomic_h_blk_row_start, &
857 atomic_h_blk_col_start)
860 ALLOCATE (atomic_s_blk_row_start(natoms_in_halo + 1), &
861 atomic_s_blk_col_start(natoms_in_halo + 1), &
868 atomic_s_blk_row_start, &
869 atomic_s_blk_col_start)
870 ALLOCATE (atomic_s(nrows_atmatrix, ncols_atmatrix))
874 atomic_s_blk_row_start, &
875 atomic_s_blk_col_start)
878 ALLOCATE (atomic_filter_mat(nrows_atmatrix, ncols_atmatrix))
880 IF (nrows_atmatrix > 0 .AND. ncols_atmatrix > 0)
THEN
881 CALL fb_fltrmat_build_atomic_fltrmat(atomic_h, &
894 owner_atom=jatom_global, &
895 owner_id_in_halo=jatom_in_halo)
896 nrows_blk_max = maxval(row_block_size_data)
897 ncols_blk_max = maxval(ntfns)
898 ALLOCATE (mat_blk(nrows_blk_max, ncols_blk_max))
899 mat_blk(:, :) = 0.0_dp
900 DO iatom_in_halo = 1, natoms_in_halo
901 iatom_global = halo_atoms(iatom_in_halo)
902 atomic_kind => particle_set(jatom_global)%atomic_kind
905 nrows_blk = row_block_size_data(iatom_global)
906 ncols_blk = ntfns(jkind)
912 DO itrial = 1, ntfns(jkind)
918 atomic_h_blk_row_start(iatom_in_halo): &
919 atomic_h_blk_row_start(iatom_in_halo + 1) - 1, &
925 atomic_s_blk_col_start(jatom_in_halo) + &
926 tfns(itrial, jkind) - 1 &
938 mat_blk(1:nrows_blk, 1:ncols_blk))
945 DEALLOCATE (atomic_h)
946 DEALLOCATE (atomic_h_blk_row_start)
947 DEALLOCATE (atomic_s)
948 DEALLOCATE (atomic_s_blk_row_start)
949 DEALLOCATE (atomic_filter_mat)
951 CALL timestop(handle)
953 END SUBROUTINE fb_fltrmat_add_blkcol_2
968 SUBROUTINE fb_fltrmat_generate_com_pairs(filter_mat, &
973 TYPE(dbcsr_type),
POINTER :: filter_mat
974 TYPE(fb_atomic_halo_obj),
INTENT(IN) :: atomic_halo
975 TYPE(mp_para_env_type),
POINTER :: para_env
976 TYPE(fb_com_atom_pairs_obj),
INTENT(INOUT) :: atom_pairs_send, atom_pairs_recv
978 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fb_fltrmat_generate_com_pairs'
980 INTEGER :: dest, handle, iatom_global, &
981 iatom_in_halo, itask, jatom_global, &
982 natoms_in_halo, nblkrows_total, &
984 INTEGER(KIND=int_8),
DIMENSION(:, :),
POINTER :: tasks_send
985 INTEGER,
DIMENSION(:),
POINTER :: halo_atoms
986 TYPE(fb_com_tasks_obj) :: com_tasks_recv, com_tasks_send
988 CALL timeset(routinen, handle)
1020 owner_atom=jatom_global, &
1021 natoms=natoms_in_halo, &
1022 halo_atoms=halo_atoms)
1023 ntasks_send = natoms_in_halo
1035 CALL dbcsr_get_info(filter_mat, &
1036 nblkrows_total=nblkrows_total)
1039 associate(src => para_env%mepos)
1042 DO iatom_in_halo = 1, natoms_in_halo
1043 iatom_global = halo_atoms(iatom_in_halo)
1045 CALL dbcsr_get_stored_coordinates(filter_mat, &
1053 iatom_global, jatom_global, &
1066 ntasks=ntasks_send, &
1067 nencode=nblkrows_total, &
1077 atom_pairs=atom_pairs_send, &
1078 natoms_encode=nblkrows_total, &
1079 send_or_recv=
"send")
1081 atom_pairs=atom_pairs_recv, &
1082 natoms_encode=nblkrows_total, &
1083 send_or_recv=
"recv")
1089 CALL timestop(handle)
1091 END SUBROUTINE fb_fltrmat_generate_com_pairs
1106 SUBROUTINE fb_fltrmat_generate_com_pairs_2(filter_mat, &
1111 TYPE(dbcsr_type),
POINTER :: filter_mat
1112 TYPE(fb_atomic_halo_list_obj),
INTENT(IN) :: atomic_halos
1113 TYPE(mp_para_env_type),
POINTER :: para_env
1114 TYPE(fb_com_atom_pairs_obj),
INTENT(INOUT) :: atom_pairs_send, atom_pairs_recv
1116 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fb_fltrmat_generate_com_pairs_2'
1118 INTEGER :: dest, handle, iatom_global, iatom_in_halo, iatom_stored, ihalo, itask, &
1119 jatom_global, jatom_stored, natoms_in_halo, nblkrows_total, nhalos, ntasks_send
1120 INTEGER(KIND=int_8),
DIMENSION(:, :),
POINTER :: tasks_send
1121 INTEGER,
DIMENSION(:),
POINTER :: halo_atoms
1122 LOGICAL :: transpose
1123 TYPE(fb_atomic_halo_obj),
DIMENSION(:),
POINTER :: halos
1124 TYPE(fb_com_tasks_obj) :: com_tasks_recv, com_tasks_send
1126 CALL timeset(routinen, handle)
1128 NULLIFY (tasks_send)
1129 CALL fb_com_tasks_nullify(com_tasks_send)
1130 CALL fb_com_tasks_nullify(com_tasks_recv)
1133 IF (fb_com_atom_pairs_has_data(atom_pairs_send))
THEN
1134 CALL fb_com_atom_pairs_init(atom_pairs_send)
1136 CALL fb_com_atom_pairs_create(atom_pairs_send)
1138 IF (fb_com_atom_pairs_has_data(atom_pairs_recv))
THEN
1139 CALL fb_com_atom_pairs_init(atom_pairs_recv)
1141 CALL fb_com_atom_pairs_create(atom_pairs_recv)
1150 CALL fb_atomic_halo_list_get(atomic_halos=atomic_halos, &
1156 DO ihalo = 1, nhalos
1157 CALL fb_atomic_halo_get(atomic_halo=halos(ihalo), &
1158 natoms=natoms_in_halo)
1159 ntasks_send = ntasks_send + natoms_in_halo
1163 ALLOCATE (tasks_send(task_n_records, ntasks_send))
1172 CALL dbcsr_get_info(filter_mat, &
1173 nblkrows_total=nblkrows_total)
1176 associate(src => para_env%mepos)
1179 DO ihalo = 1, nhalos
1180 CALL fb_atomic_halo_get(atomic_halo=halos(ihalo), &
1181 owner_atom=jatom_global, &
1182 natoms=natoms_in_halo, &
1183 halo_atoms=halo_atoms)
1184 DO iatom_in_halo = 1, natoms_in_halo
1185 iatom_global = halo_atoms(iatom_in_halo)
1186 iatom_stored = iatom_global
1187 jatom_stored = jatom_global
1190 CALL dbcsr_get_stored_coordinates(filter_mat, &
1195 tasks_send(task_dest, itask) = dest
1196 tasks_send(task_src, itask) = src
1197 CALL fb_com_tasks_encode_pair(tasks_send(task_pair, itask), &
1198 iatom_global, jatom_global, &
1201 tasks_send(task_cost, itask) = 0
1208 ntasks_send = itask - 1
1210 CALL fb_com_tasks_create(com_tasks_send)
1211 CALL fb_com_tasks_set(com_tasks=com_tasks_send, &
1212 task_dim=task_n_records, &
1213 ntasks=ntasks_send, &
1214 nencode=nblkrows_total, &
1218 CALL fb_com_tasks_create(com_tasks_recv)
1219 CALL fb_com_tasks_transpose_dest_src(com_tasks_recv,
"<", com_tasks_send, &
1224 CALL fb_com_tasks_build_atom_pairs(com_tasks=com_tasks_send, &
1225 atom_pairs=atom_pairs_send, &
1226 natoms_encode=nblkrows_total, &
1227 send_or_recv=
"send")
1228 CALL fb_com_tasks_build_atom_pairs(com_tasks=com_tasks_recv, &
1229 atom_pairs=atom_pairs_recv, &
1230 natoms_encode=nblkrows_total, &
1231 send_or_recv=
"recv")
1234 CALL fb_com_tasks_release(com_tasks_recv)
1235 CALL fb_com_tasks_release(com_tasks_send)
1237 CALL timestop(handle)
1239 END SUBROUTINE fb_fltrmat_generate_com_pairs_2
1253 SUBROUTINE fb_fltrmat_build_atomic_fltrmat(atomic_H, &
1257 atomic_filter_mat, &
1259 REAL(kind=dp),
DIMENSION(:, :),
INTENT(IN) :: atomic_h, atomic_s
1260 REAL(kind=dp),
INTENT(IN) :: fermi_level, filter_temp
1261 REAL(kind=dp),
DIMENSION(:, :),
INTENT(OUT) :: atomic_filter_mat
1262 REAL(kind=dp),
INTENT(IN) :: tolerance
1264 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fb_fltrmat_build_atomic_fltrmat'
1266 INTEGER :: handle, handle_dgemm, handle_dsygv, ii, &
1267 info, jj, mat_dim, work_array_size
1269 REAL(kind=dp),
ALLOCATABLE,
DIMENSION(:) :: eigenvalues, filter_function, work
1270 REAL(kind=dp),
ALLOCATABLE,
DIMENSION(:, :) :: atomic_s_copy, eigenvectors, &
1271 filtered_eigenvectors
1273 CALL timeset(routinen, handle)
1279 check_ok =
SIZE(atomic_filter_mat, 1) > 0 .AND. &
1280 SIZE(atomic_filter_mat, 2) > 0
1284 atomic_filter_mat = 0.0_dp
1285 mat_dim =
SIZE(atomic_h, 1)
1288 ALLOCATE (eigenvalues(mat_dim))
1292 ALLOCATE (atomic_s_copy(
SIZE(atomic_s, 1),
SIZE(atomic_s, 2)))
1293 atomic_s_copy(:, :) = atomic_s(:, :)
1294 ALLOCATE (eigenvectors(
SIZE(atomic_h, 1),
SIZE(atomic_h, 2)))
1295 eigenvectors(:, :) = atomic_h(:, :)
1297 CALL timeset(
"fb_atomic_filter_dsygv", handle_dsygv)
1312 work_array_size = nint(work(1))
1315 ALLOCATE (work(work_array_size))
1318 atomic_s_copy(:, :) = atomic_s(:, :)
1319 eigenvectors(:, :) = atomic_h(:, :)
1334 IF (info .NE. 0)
THEN
1335 WRITE (*, *)
"DSYGV ERROR MESSAGE: ", info
1336 cpabort(
"DSYGV failed")
1339 CALL timestop(handle_dsygv)
1342 DEALLOCATE (atomic_s_copy)
1345 ALLOCATE (filter_function(mat_dim))
1346 filter_function = 0.0_dp
1347 CALL fb_fltrmat_fermi_dirac_mu(filter_function, &
1351 DEALLOCATE (eigenvalues)
1355 ALLOCATE (filtered_eigenvectors(mat_dim, mat_dim))
1358 filtered_eigenvectors(ii, jj) = &
1359 filter_function(jj)*eigenvectors(ii, jj)
1363 DEALLOCATE (filter_function)
1365 CALL timeset(
"fb_atomic_filter_dgemm", handle_dgemm)
1374 filtered_eigenvectors, &
1379 atomic_filter_mat, &
1382 CALL timestop(handle_dgemm)
1386 DO jj = 1,
SIZE(atomic_filter_mat, 2)
1387 DO ii = 1,
SIZE(atomic_filter_mat, 1)
1388 IF (abs(atomic_filter_mat(ii, jj)) < tolerance)
THEN
1389 atomic_filter_mat(ii, jj) = 0.0_dp
1394 DEALLOCATE (filtered_eigenvectors)
1395 DEALLOCATE (eigenvectors)
1397 CALL timestop(handle)
1399 END SUBROUTINE fb_fltrmat_build_atomic_fltrmat
1410 SUBROUTINE fb_fltrmat_fermi_dirac_mu(f, eigenvals, T, mu)
1411 REAL(kind=dp),
DIMENSION(:),
INTENT(OUT) :: f
1412 REAL(kind=dp),
DIMENSION(:),
INTENT(IN) :: eigenvals
1413 REAL(kind=dp),
INTENT(IN) :: t, mu
1415 REAL(kind=dp) :: kts, ne
1419 CALL fermi(f, ne, kts, eigenvals, mu, t, 1.0_dp)
1420 END SUBROUTINE fb_fltrmat_fermi_dirac_mu
1432 SUBROUTINE fb_fltrmat_fermi_dirac_ne(f, eigenvals, T, ne, maxocc)
1433 REAL(kind=dp),
DIMENSION(:),
INTENT(OUT) :: f
1434 REAL(kind=dp),
DIMENSION(:),
INTENT(IN) :: eigenvals
1435 REAL(kind=dp),
INTENT(IN) :: t, ne, maxocc
1437 REAL(kind=dp) :: kts, mu
1443 CALL fermifixed(f, mu, kts, eigenvals, ne, t, maxocc)
1444 END SUBROUTINE fb_fltrmat_fermi_dirac_ne
static void dgemm(const char transa, const char transb, const int m, const int n, const int k, const double alpha, const double *a, const int lda, const double *b, const int ldb, const double beta, double *c, const int ldc)
Convenient wrapper to hide Fortran nature of dgemm_, swapping a and b.
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
deal with the Fermi distribution, compute it, fix mu, get derivs
subroutine, public fermi(f, N, kTS, e, mu, T, maxocc, estate, festate)
returns occupations according to Fermi-Dirac statistics for a given set of energies and fermi level....
subroutine, public fermifixed(f, mu, kTS, e, N, T, maxocc, estate, festate)
returns occupations according to Fermi-Dirac statistics for a given set of energies and number of ele...
Defines the basic variable types.
integer, parameter, public int_8
integer, parameter, public dp
integer, parameter, public default_string_length
Interface to the message passing library MPI.
Define the data structure for the particle information.
subroutine, public fb_atomic_halo_list_get(atomic_halos, nhalos, max_nhalos, halos)
Gets attributes from an fb_atomic_halo_list object, one should only access the data content in a fb_a...
subroutine, public fb_atomic_halo_get(atomic_halo, owner_atom, owner_id_in_halo, natoms, nelectrons, halo_atoms, sorted, cost)
Gets attributes from a fb_atomic_halo object, one should only access the data content in a fb_atomic_...
subroutine, public fb_atomic_halo_set(atomic_halo, owner_atom, owner_id_in_halo, natoms, nelectrons, halo_atoms, sorted, cost)
Sets attributes in a fb_atomic_halo object, one should only set the data content in a fb_atomic_halo ...
subroutine, public fb_atomic_halo_create(atomic_halo)
Creates and initialises an empty fb_atomic_halo object.
subroutine, public fb_atomic_halo_nullify(atomic_halo)
Nullifies a fb_atomic_halo object, note that it does not release the original object....
subroutine, public fb_atomic_halo_release(atomic_halo)
Releases an fb_atomic_halo object.
subroutine, public fb_atmatrix_calc_size(dbcsr_mat, atomic_halo, nrows, ncols, blk_row_start, blk_col_start)
Calculates the atomic matrix size from a given DBCSR matrix and atomic halo. It also calculates the f...
subroutine, public fb_atmatrix_generate_com_pairs_2(dbcsr_mat, atomic_halos, para_env, atom_pairs_send, atom_pairs_recv)
generate list of blocks (atom pairs) of a DBCSR matrix to be sent and received in order to construct ...
subroutine, public fb_atmatrix_construct_2(matrix_storage, atomic_halo, atomic_matrix, blk_row_start, blk_col_start)
Constructs atomic matrix for filter basis method from a given DBCSR matrix and a set of atomic send a...
subroutine, public fb_atmatrix_construct(dbcsr_mat, atomic_halo, para_env, atomic_matrix, blk_row_start, blk_col_start)
Constructs atomic matrix for filter basis method from a given DBCSR matrix and a set of atomic send a...
subroutine, public fb_com_atom_pairs_init(atom_pairs)
Initialises an fb_com_atom_pairs object, and makes it empty.
integer, parameter, public task_pair
subroutine, public fb_com_atom_pairs_decode(ind, pe, iatom, jatom, natoms)
Decodes a single integer into the (rank, iatom, jatom) index of a communication task to send/receive ...
integer, parameter, public task_src
subroutine, public fb_com_tasks_nullify(com_tasks)
Nullifies a fb_com_tasks object, note that it does not release the original object....
subroutine, public fb_com_tasks_encode_pair(ind, iatom, jatom, natoms)
Encodes (iatom, jatom) pair index of a block into a single integer.
subroutine, public fb_com_atom_pairs_distribute_blks(matrix_storage, atom_pairs_send, atom_pairs_recv, para_env, dbcsr_mat)
Given send and recv fb_com_atom_pair object, distribute the matrix blocks stored in a fb_matrix_data ...
subroutine, public fb_com_tasks_build_atom_pairs(com_tasks, atom_pairs, natoms_encode, send_or_recv)
Generate send or receive atom_pair lists from a com_tasks object. atom_pair list is used as a condens...
subroutine, public fb_com_atom_pairs_create(atom_pairs)
Creates and initialises an empty fb_com_atom_pairs object.
subroutine, public fb_com_tasks_transpose_dest_src(tasks_dest_is_me, direction, tasks_src_is_me, para_env)
Start from a local set of tasks that has desc/src process equal to the local MPI rank,...
logical function, public fb_com_atom_pairs_has_data(atom_pairs)
Checks if a fb_com_atom_pairs object is associated with an actual data content or not.
subroutine, public fb_com_atom_pairs_get(atom_pairs, npairs, natoms_encode, pairs)
Gets attributes from a fb_com_atom_pairs object, one should only access the data content in a fb_com_...
subroutine, public fb_com_atom_pairs_nullify(atom_pairs)
Nullifies a fb_com_atom_pairs object, note that it does not release the original object....
subroutine, public fb_com_atom_pairs_release(atom_pairs)
Releases an fb_com_atom_pairs object.
subroutine, public fb_com_tasks_create(com_tasks)
Creates and initialises an empty fb_com_tasks object.
integer, parameter, public task_cost
subroutine, public fb_com_tasks_release(com_tasks)
Releases an fb_com_tasks object.
subroutine, public fb_com_atom_pairs_gather_blks(dbcsr_mat, atom_pairs_send, atom_pairs_recv, para_env, matrix_storage)
Given send and recv fb_com_atom_pair object, gather all the relevant DBCSR matrix blocks together,...
subroutine, public fb_com_tasks_set(com_tasks, task_dim, ntasks, nencode, tasks)
Sets attributes in a fb_com_tasks object, one should only access the data content in a fb_com_tasks o...
integer, parameter, public task_dest
integer, parameter, public task_n_records
subroutine, public fb_com_atom_pairs_calc_buffer_sizes(atom_pairs, nprocs, row_blk_sizes, col_blk_sizes, sendrecv_sizes, sendrecv_disps, sendrecv_pair_counts, sendrecv_pair_disps)
Calculate the MPI send or recv buffer sizes according to the communication pairs (atom_pairs) and DBC...
subroutine, public fb_fltrmat_build_2(H_mat, S_mat, atomic_halos, trial_fns, para_env, particle_set, fermi_level, filter_temp, name, filter_mat, tolerance)
Build the filter matrix, with MPI communications grouped together. More effcient on communication,...
subroutine, public fb_fltrmat_build(H_mat, S_mat, atomic_halos, trial_fns, para_env, particle_set, fermi_level, filter_temp, name, filter_mat, tolerance)
Build the filter matrix, with MPI communications happening at each step. Less efficient on communicat...
pure logical function, public fb_matrix_data_has_data(matrix_data)
check if the object has data associated to it
subroutine, public fb_matrix_data_add(matrix_data, row, col, blk)
Add a matrix block to a fb_matrix_data object.
subroutine, public fb_matrix_data_create(matrix_data, nmax, nencode)
Creates and initialises an empty fb_matrix_data object of a given size.
pure subroutine, public fb_matrix_data_nullify(matrix_data)
Nullifies a fb_matrix_data object.
subroutine, public fb_matrix_data_release(matrix_data)
releases given object
subroutine, public fb_trial_fns_get(trial_fns, nfunctions, functions)
get values of the attributes of a fb_trial_fns object
Utilities for string manipulations.
subroutine, public compress(string, full)
Eliminate multiple space characters in a string. If full is .TRUE., then all spaces are eliminated.
elemental subroutine, public uppercase(string)
Convert all lower case characters in a string to upper case.