Skip to content

Commit

Permalink
pretty
Browse files Browse the repository at this point in the history
  • Loading branch information
@hforbert
hforbert committed Feb 3, 2020
1 parent 5ffbcad commit 40778af
Show file tree
Hide file tree
Showing 49 changed files with 8,759 additions and 8,803 deletions.
161 changes: 80 additions & 81 deletions src/arnoldi/arnoldi_data_manipulation.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,27 +7,27 @@
!> \param max_iter ...
! **************************************************************************************************
SUBROUTINE setup_arnoldi_data_${nametype1}$ (arnoldi_data, matrix, max_iter)
TYPE(arnoldi_data_type) :: arnoldi_data
TYPE(dbcsr_p_type), DIMENSION(:) :: matrix
INTEGER :: max_iter
TYPE(arnoldi_data_type) :: arnoldi_data
TYPE(dbcsr_p_type), DIMENSION(:) :: matrix
INTEGER :: max_iter

CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_arnoldi_data_${nametype1}$', &
routineP = moduleN//':'//routineN
CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_arnoldi_data_${nametype1}$', &
routineP = moduleN//':'//routineN

INTEGER :: nrow_local
TYPE(arnoldi_data_${nametype1}$_type), POINTER :: ar_data
INTEGER :: nrow_local
TYPE(arnoldi_data_${nametype1}$_type), POINTER :: ar_data

ALLOCATE(ar_data)
CALL dbcsr_get_info(matrix=matrix(1)%matrix, nfullrows_local=nrow_local)
ALLOCATE(ar_data%f_vec(nrow_local))
ALLOCATE(ar_data%x_vec(nrow_local))
ALLOCATE(ar_data%Hessenberg(max_iter+1, max_iter))
ALLOCATE(ar_data%local_history(nrow_local, max_iter))
ALLOCATE (ar_data)
CALL dbcsr_get_info(matrix=matrix(1)%matrix, nfullrows_local=nrow_local)
ALLOCATE (ar_data%f_vec(nrow_local))
ALLOCATE (ar_data%x_vec(nrow_local))
ALLOCATE (ar_data%Hessenberg(max_iter + 1, max_iter))
ALLOCATE (ar_data%local_history(nrow_local, max_iter))

ALLOCATE(ar_data%evals(max_iter))
ALLOCATE(ar_data%revec(max_iter, max_iter))
ALLOCATE (ar_data%evals(max_iter))
ALLOCATE (ar_data%revec(max_iter, max_iter))

CALL set_data_${nametype1}$(arnoldi_data,ar_data)
CALL set_data_${nametype1}$ (arnoldi_data, ar_data)

END SUBROUTINE setup_arnoldi_data_${nametype1}$

Expand All @@ -36,21 +36,21 @@ END SUBROUTINE setup_arnoldi_data_${nametype1}$
!> \param arnoldi_data ...
! **************************************************************************************************
SUBROUTINE deallocate_arnoldi_data_${nametype1}$ (arnoldi_data)
TYPE(arnoldi_data_type) :: arnoldi_data
TYPE(arnoldi_data_type) :: arnoldi_data

CHARACTER(LEN=*), PARAMETER :: routineN = 'deallocate_arnoldi_data_${nametype1}$', &
routineP = moduleN//':'//routineN
CHARACTER(LEN=*), PARAMETER :: routineN = 'deallocate_arnoldi_data_${nametype1}$', &
routineP = moduleN//':'//routineN

TYPE(arnoldi_data_${nametype1}$_type), POINTER :: ar_data
TYPE(arnoldi_data_${nametype1}$_type), POINTER :: ar_data

ar_data=>get_data_${nametype1}$(arnoldi_data)
IF(ASSOCIATED(ar_data%f_vec))DEALLOCATE(ar_data%f_vec)
IF(ASSOCIATED(ar_data%x_vec))DEALLOCATE(ar_data%x_vec)
IF(ASSOCIATED(ar_data%Hessenberg))DEALLOCATE(ar_data%Hessenberg)
IF(ASSOCIATED(ar_data%local_history))DEALLOCATE(ar_data%local_history)
IF(ASSOCIATED(ar_data%evals))DEALLOCATE(ar_data%evals)
IF(ASSOCIATED(ar_data%revec))DEALLOCATE(ar_data%revec)
DEALLOCATE(ar_data)
ar_data => get_data_${nametype1}$ (arnoldi_data)
IF (ASSOCIATED(ar_data%f_vec)) DEALLOCATE (ar_data%f_vec)
IF (ASSOCIATED(ar_data%x_vec)) DEALLOCATE (ar_data%x_vec)
IF (ASSOCIATED(ar_data%Hessenberg)) DEALLOCATE (ar_data%Hessenberg)
IF (ASSOCIATED(ar_data%local_history)) DEALLOCATE (ar_data%local_history)
IF (ASSOCIATED(ar_data%evals)) DEALLOCATE (ar_data%evals)
IF (ASSOCIATED(ar_data%revec)) DEALLOCATE (ar_data%revec)
DEALLOCATE (ar_data)

END SUBROUTINE deallocate_arnoldi_data_${nametype1}$

Expand All @@ -61,71 +61,70 @@ END SUBROUTINE deallocate_arnoldi_data_${nametype1}$
!> \param matrix ...
!> \param vector ...
! **************************************************************************************************
SUBROUTINE get_selected_ritz_vector_${nametype1}$(arnoldi_data,ind,matrix,vector)
TYPE(arnoldi_data_type) :: arnoldi_data
INTEGER :: ind
TYPE(dbcsr_type) :: matrix
TYPE(dbcsr_type) :: vector

CHARACTER(LEN=*), PARAMETER :: routineN = 'get_selected_ritz_vector_${nametype1}$', &
routineP = moduleN//':'//routineN

TYPE(arnoldi_data_${nametype1}$_type), POINTER :: ar_data
INTEGER :: vsize, myind, sspace_size, i
INTEGER, DIMENSION(:), POINTER :: selected_ind
COMPLEX(${type_prec}$),DIMENSION(:),ALLOCATABLE :: ritz_v
${type_nametype1}$, DIMENSION(:), POINTER :: data_vec
TYPE(arnoldi_control_type), POINTER :: control

control=>get_control(arnoldi_data)
selected_ind=>get_sel_ind(arnoldi_data)
ar_data=>get_data_${nametype1}$(arnoldi_data)
sspace_size=get_subsp_size(arnoldi_data)
vsize=SIZE(ar_data%f_vec)
myind=selected_ind(ind)
ALLOCATE(ritz_v(vsize))
ritz_v=CMPLX(0.0,0.0,${type_prec}$)

CALL dbcsr_release(vector)
CALL create_col_vec_from_matrix(vector,matrix,1)
IF(control%local_comp)THEN
DO i=1,sspace_size
ritz_v(:)=ritz_v(:)+ar_data%local_history(:,i)*ar_data%revec(i,myind)
END DO
data_vec => dbcsr_get_data_p (vector, select_data_type=${nametype_zero}$)
! is a bit odd but ritz_v is always complex and matrix type determines where it goes
! again I hope the user knows what is required
data_vec(1:vsize) =${vartype}$(ritz_v(1:vsize),KIND=${type_prec}$)
END IF

DEALLOCATE(ritz_v)
SUBROUTINE get_selected_ritz_vector_${nametype1}$ (arnoldi_data, ind, matrix, vector)
TYPE(arnoldi_data_type) :: arnoldi_data
INTEGER :: ind
TYPE(dbcsr_type) :: matrix
TYPE(dbcsr_type) :: vector

CHARACTER(LEN=*), PARAMETER :: routineN = 'get_selected_ritz_vector_${nametype1}$', &
routineP = moduleN//':'//routineN

TYPE(arnoldi_data_${nametype1}$_type), POINTER :: ar_data
INTEGER :: vsize, myind, sspace_size, i
INTEGER, DIMENSION(:), POINTER :: selected_ind
COMPLEX(${type_prec}$), DIMENSION(:), ALLOCATABLE :: ritz_v
${type_nametype1}$, DIMENSION(:), POINTER :: data_vec
TYPE(arnoldi_control_type), POINTER :: control

control => get_control(arnoldi_data)
selected_ind => get_sel_ind(arnoldi_data)
ar_data => get_data_${nametype1}$ (arnoldi_data)
sspace_size = get_subsp_size(arnoldi_data)
vsize = SIZE(ar_data%f_vec)
myind = selected_ind(ind)
ALLOCATE (ritz_v(vsize))
ritz_v = CMPLX(0.0, 0.0, ${type_prec}$)

CALL dbcsr_release(vector)
CALL create_col_vec_from_matrix(vector, matrix, 1)
IF (control%local_comp) THEN
DO i = 1, sspace_size
ritz_v(:) = ritz_v(:) + ar_data%local_history(:, i)*ar_data%revec(i, myind)
END DO
data_vec => dbcsr_get_data_p(vector, select_data_type=${nametype_zero}$)
! is a bit odd but ritz_v is always complex and matrix type determines where it goes
! again I hope the user knows what is required
data_vec(1:vsize) = ${vartype}$ (ritz_v(1:vsize), KIND=${type_prec}$)
END IF

DEALLOCATE (ritz_v)

END SUBROUTINE get_selected_ritz_vector_${nametype1}$


! **************************************************************************************************
!> \brief ...
!> \param arnoldi_data ...
!> \param vector ...
! **************************************************************************************************
SUBROUTINE set_initial_vector_${nametype1}$(arnoldi_data,vector)
TYPE(arnoldi_data_type) :: arnoldi_data
TYPE(dbcsr_type) :: vector
SUBROUTINE set_initial_vector_${nametype1}$ (arnoldi_data, vector)
TYPE(arnoldi_data_type) :: arnoldi_data
TYPE(dbcsr_type) :: vector

CHARACTER(LEN=*), PARAMETER :: routineN = 'set_initial_vector_${nametype1}$', &
routineP = moduleN//':'//routineN
CHARACTER(LEN=*), PARAMETER :: routineN = 'set_initial_vector_${nametype1}$', &
routineP = moduleN//':'//routineN

TYPE(arnoldi_data_${nametype1}$_type), POINTER :: ar_data
${type_nametype1}$, DIMENSION(:), POINTER :: data_vec
INTEGER :: nrow_local, ncol_local
TYPE(arnoldi_control_type), POINTER :: control
TYPE(arnoldi_data_${nametype1}$_type), POINTER :: ar_data
${type_nametype1}$, DIMENSION(:), POINTER :: data_vec
INTEGER :: nrow_local, ncol_local
TYPE(arnoldi_control_type), POINTER :: control

control=>get_control(arnoldi_data)
control => get_control(arnoldi_data)

CALL dbcsr_get_info(matrix=vector, nfullrows_local=nrow_local, nfullcols_local=ncol_local)
ar_data=>get_data_${nametype1}$(arnoldi_data)
data_vec => dbcsr_get_data_p (vector, select_data_type=${nametype_zero}$)
IF(nrow_local*ncol_local>0)ar_data%f_vec(1:nrow_local)=data_vec(1:nrow_local)
CALL dbcsr_get_info(matrix=vector, nfullrows_local=nrow_local, nfullcols_local=ncol_local)
ar_data => get_data_${nametype1}$ (arnoldi_data)
data_vec => dbcsr_get_data_p(vector, select_data_type=${nametype_zero}$)
IF (nrow_local*ncol_local > 0) ar_data%f_vec(1:nrow_local) = data_vec(1:nrow_local)

END SUBROUTINE set_initial_vector_${nametype1}$
#:endfor
44 changes: 22 additions & 22 deletions src/arnoldi/arnoldi_data_methods.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,21 +13,21 @@
! **************************************************************************************************

MODULE arnoldi_data_methods
USE arnoldi_types, ONLY: &
arnoldi_control_type, arnoldi_data_c_type, arnoldi_data_d_type, arnoldi_data_s_type, &
arnoldi_data_type, arnoldi_data_z_type, get_control, get_data_c, get_data_d, get_data_s, &
get_data_z, get_evals_c, get_evals_d, get_evals_s, get_evals_z, get_sel_ind, has_d_cmplx, &
has_d_real, has_s_cmplx, has_s_real, set_control, set_data_c, set_data_d, set_data_s, &
set_data_z
USE dbcsr_api, ONLY: &
dbcsr_distribution_get, dbcsr_distribution_type, dbcsr_get_data_p, dbcsr_get_data_type, &
dbcsr_get_info, dbcsr_get_matrix_type, dbcsr_mp_grid_setup, dbcsr_p_type, dbcsr_release, &
dbcsr_type, dbcsr_type_complex_4, dbcsr_type_complex_8, dbcsr_type_real_4, &
dbcsr_type_real_8, dbcsr_type_symmetric
USE dbcsr_vector, ONLY: create_col_vec_from_matrix
USE kinds, ONLY: real_4,&
real_8
USE util, ONLY: sort
USE arnoldi_types, ONLY: &
arnoldi_control_type, arnoldi_data_c_type, arnoldi_data_d_type, arnoldi_data_s_type, &
arnoldi_data_type, arnoldi_data_z_type, get_control, get_data_c, get_data_d, get_data_s, &
get_data_z, get_evals_c, get_evals_d, get_evals_s, get_evals_z, get_sel_ind, has_d_cmplx, &
has_d_real, has_s_cmplx, has_s_real, set_control, set_data_c, set_data_d, set_data_s, &
set_data_z
USE dbcsr_api, ONLY: &
dbcsr_distribution_get, dbcsr_distribution_type, dbcsr_get_data_p, dbcsr_get_data_type, &
dbcsr_get_info, dbcsr_get_matrix_type, dbcsr_mp_grid_setup, dbcsr_p_type, dbcsr_release, &
dbcsr_type, dbcsr_type_complex_4, dbcsr_type_complex_8, dbcsr_type_real_4, &
dbcsr_type_real_8, dbcsr_type_symmetric
USE dbcsr_vector, ONLY: create_col_vec_from_matrix
USE kinds, ONLY: real_4, &
real_8
USE util, ONLY: sort
#include "../base/base_uses.f90"

IMPLICIT NONE
Expand Down Expand Up @@ -71,12 +71,12 @@ SUBROUTINE setup_arnoldi_data(arnoldi_data, matrix, max_iter, threshold, selecti
LOGICAL :: generalized_ev, iram

CHARACTER(LEN=*), PARAMETER :: routineN = 'setup_arnoldi_data', &
routineP = moduleN//':'//routineN
routineP = moduleN//':'//routineN

CALL setup_arnoldi_control(arnoldi_data, matrix, max_iter, threshold, selection_crit, &
nval_request, nrestarts, generalized_ev, iram)

SELECT CASE (dbcsr_get_data_type (matrix (1)%matrix))
SELECT CASE (dbcsr_get_data_type(matrix(1)%matrix))
CASE (dbcsr_type_real_8)
CALL setup_arnoldi_data_d(arnoldi_data, matrix, max_iter)
CASE (dbcsr_type_real_4)
Expand Down Expand Up @@ -111,7 +111,7 @@ SUBROUTINE setup_arnoldi_control(arnoldi_data, matrix, max_iter, threshold, sele
LOGICAL :: generalized_ev, iram

CHARACTER(LEN=*), PARAMETER :: routineN = 'setup_arnoldi_control', &
routineP = moduleN//':'//routineN
routineP = moduleN//':'//routineN

LOGICAL :: subgroups_defined
TYPE(arnoldi_control_type), POINTER :: control
Expand Down Expand Up @@ -184,7 +184,7 @@ SUBROUTINE get_selected_ritz_vector(arnoldi_data, ind, matrix, vector)
TYPE(dbcsr_type) :: matrix, vector

CHARACTER(LEN=*), PARAMETER :: routineN = 'get_selected_ritz_vector', &
routineP = moduleN//':'//routineN
routineP = moduleN//':'//routineN

IF (has_d_real(arnoldi_data)) CALL get_selected_ritz_vector_d(arnoldi_data, ind, matrix, vector)
IF (has_s_real(arnoldi_data)) CALL get_selected_ritz_vector_s(arnoldi_data, ind, matrix, vector)
Expand All @@ -201,7 +201,7 @@ SUBROUTINE deallocate_arnoldi_data(arnoldi_data)
TYPE(arnoldi_data_type) :: arnoldi_data

CHARACTER(LEN=*), PARAMETER :: routineN = 'deallocate_arnoldi_data', &
routineP = moduleN//':'//routineN
routineP = moduleN//':'//routineN

TYPE(arnoldi_control_type), POINTER :: control

Expand Down Expand Up @@ -324,7 +324,7 @@ FUNCTION get_selected_ritz_val(ar_data, ind) RESULT(eval_out)
COMPLEX(real_8) :: eval_out
CHARACTER(LEN=*), PARAMETER :: routineN = 'get_selected_ritz_val', &
routineP = moduleN//':'//routineN
routineP = moduleN//':'//routineN
COMPLEX(real_4), DIMENSION(:), POINTER :: evals_s
COMPLEX(real_8), DIMENSION(:), POINTER :: evals_d
Expand Down Expand Up @@ -359,7 +359,7 @@ SUBROUTINE get_all_selected_ritz_val(ar_data, eval_out)
COMPLEX(real_8), DIMENSION(:) :: eval_out
CHARACTER(LEN=*), PARAMETER :: routineN = 'get_all_selected_ritz_val', &
routineP = moduleN//':'//routineN
routineP = moduleN//':'//routineN
COMPLEX(real_4), DIMENSION(:), POINTER :: evals_s
COMPLEX(real_8), DIMENSION(:), POINTER :: evals_d
Expand Down

0 comments on commit 40778af

Please sign in to comment.