1#:include 'arnoldi.fypp' 2#:for nametype1, type_prec, real_zero, nametype_zero, type_nametype1, vartype in inst_params_1 3! ************************************************************************************************** 4!> \brief ... 5!> \param arnoldi_data ... 6!> \param matrix ... 7!> \param max_iter ... 8! ************************************************************************************************** 9 SUBROUTINE setup_arnoldi_data_${nametype1}$ (arnoldi_data, matrix, max_iter) 10 TYPE(arnoldi_data_type) :: arnoldi_data 11 TYPE(dbcsr_p_type), DIMENSION(:) :: matrix 12 INTEGER :: max_iter 13 14 CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_arnoldi_data_${nametype1}$', & 15 routineP = moduleN//':'//routineN 16 17 INTEGER :: nrow_local 18 TYPE(arnoldi_data_${nametype1}$_type), POINTER :: ar_data 19 20 ALLOCATE(ar_data) 21 CALL dbcsr_get_info(matrix=matrix(1)%matrix, nfullrows_local=nrow_local) 22 ALLOCATE(ar_data%f_vec(nrow_local)) 23 ALLOCATE(ar_data%x_vec(nrow_local)) 24 ALLOCATE(ar_data%Hessenberg(max_iter+1, max_iter)) 25 ALLOCATE(ar_data%local_history(nrow_local, max_iter)) 26 27 ALLOCATE(ar_data%evals(max_iter)) 28 ALLOCATE(ar_data%revec(max_iter, max_iter)) 29 30 CALL set_data_${nametype1}$(arnoldi_data,ar_data) 31 32 END SUBROUTINE setup_arnoldi_data_${nametype1}$ 33 34! ************************************************************************************************** 35!> \brief ... 36!> \param arnoldi_data ... 37! ************************************************************************************************** 38 SUBROUTINE deallocate_arnoldi_data_${nametype1}$ (arnoldi_data) 39 TYPE(arnoldi_data_type) :: arnoldi_data 40 41 CHARACTER(LEN=*), PARAMETER :: routineN = 'deallocate_arnoldi_data_${nametype1}$', & 42 routineP = moduleN//':'//routineN 43 44 TYPE(arnoldi_data_${nametype1}$_type), POINTER :: ar_data 45 46 ar_data=>get_data_${nametype1}$(arnoldi_data) 47 IF(ASSOCIATED(ar_data%f_vec))DEALLOCATE(ar_data%f_vec) 48 IF(ASSOCIATED(ar_data%x_vec))DEALLOCATE(ar_data%x_vec) 49 IF(ASSOCIATED(ar_data%Hessenberg))DEALLOCATE(ar_data%Hessenberg) 50 IF(ASSOCIATED(ar_data%local_history))DEALLOCATE(ar_data%local_history) 51 IF(ASSOCIATED(ar_data%evals))DEALLOCATE(ar_data%evals) 52 IF(ASSOCIATED(ar_data%revec))DEALLOCATE(ar_data%revec) 53 DEALLOCATE(ar_data) 54 55 END SUBROUTINE deallocate_arnoldi_data_${nametype1}$ 56 57! ************************************************************************************************** 58!> \brief ... 59!> \param arnoldi_data ... 60!> \param ind ... 61!> \param matrix ... 62!> \param vector ... 63! ************************************************************************************************** 64 SUBROUTINE get_selected_ritz_vector_${nametype1}$(arnoldi_data,ind,matrix,vector) 65 TYPE(arnoldi_data_type) :: arnoldi_data 66 INTEGER :: ind 67 TYPE(dbcsr_type) :: matrix 68 TYPE(dbcsr_type) :: vector 69 70 CHARACTER(LEN=*), PARAMETER :: routineN = 'get_selected_ritz_vector_${nametype1}$', & 71 routineP = moduleN//':'//routineN 72 73 TYPE(arnoldi_data_${nametype1}$_type), POINTER :: ar_data 74 INTEGER :: vsize, myind, sspace_size, i 75 INTEGER, DIMENSION(:), POINTER :: selected_ind 76 COMPLEX(${type_prec}$),DIMENSION(:),ALLOCATABLE :: ritz_v 77 ${type_nametype1}$, DIMENSION(:), POINTER :: data_vec 78 TYPE(arnoldi_control_type), POINTER :: control 79 80 control=>get_control(arnoldi_data) 81 selected_ind=>get_sel_ind(arnoldi_data) 82 ar_data=>get_data_${nametype1}$(arnoldi_data) 83 sspace_size=get_subsp_size(arnoldi_data) 84 vsize=SIZE(ar_data%f_vec) 85 myind=selected_ind(ind) 86 ALLOCATE(ritz_v(vsize)) 87 ritz_v=CMPLX(0.0,0.0,${type_prec}$) 88 89 CALL dbcsr_release(vector) 90 CALL create_col_vec_from_matrix(vector,matrix,1) 91 IF(control%local_comp)THEN 92 DO i=1,sspace_size 93 ritz_v(:)=ritz_v(:)+ar_data%local_history(:,i)*ar_data%revec(i,myind) 94 END DO 95 data_vec => dbcsr_get_data_p (vector, select_data_type=${nametype_zero}$) 96 ! is a bit odd but ritz_v is always complex and matrix type determines where it goes 97 ! again I hope the user knows what is required 98 data_vec(1:vsize) =${vartype}$(ritz_v(1:vsize),KIND=${type_prec}$) 99 END IF 100 101 DEALLOCATE(ritz_v) 102 103 END SUBROUTINE get_selected_ritz_vector_${nametype1}$ 104 105 106! ************************************************************************************************** 107!> \brief ... 108!> \param arnoldi_data ... 109!> \param vector ... 110! ************************************************************************************************** 111 SUBROUTINE set_initial_vector_${nametype1}$(arnoldi_data,vector) 112 TYPE(arnoldi_data_type) :: arnoldi_data 113 TYPE(dbcsr_type) :: vector 114 115 CHARACTER(LEN=*), PARAMETER :: routineN = 'set_initial_vector_${nametype1}$', & 116 routineP = moduleN//':'//routineN 117 118 TYPE(arnoldi_data_${nametype1}$_type), POINTER :: ar_data 119 ${type_nametype1}$, DIMENSION(:), POINTER :: data_vec 120 INTEGER :: nrow_local, ncol_local 121 TYPE(arnoldi_control_type), POINTER :: control 122 123 control=>get_control(arnoldi_data) 124 125 CALL dbcsr_get_info(matrix=vector, nfullrows_local=nrow_local, nfullcols_local=ncol_local) 126 ar_data=>get_data_${nametype1}$(arnoldi_data) 127 data_vec => dbcsr_get_data_p (vector, select_data_type=${nametype_zero}$) 128 IF(nrow_local*ncol_local>0)ar_data%f_vec(1:nrow_local)=data_vec(1:nrow_local) 129 130 END SUBROUTINE set_initial_vector_${nametype1}$ 131#:endfor 132