comp-chem/cp2k
1
0
Fork 0
mirror of https://github.com/cp2k/cp2k.git synced 2026-07-28 22:25:32 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

Make initialization of array in cp_fm_create optional. (#4579)

Browse source
This commit is contained in:
Juerg Hutter 2025-12-03 09:21:11 +01:00 • committed by GitHub
parent 421338ca7d
commit 6b2ed39932
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
27 changed files with 157 additions and 95 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/bse_util.F
View file

@ -1280,9 +1280,9 @@ CONTAINS
CALL cp_fm_struct_create(fm_struct_ij, para_env, context, dimen_RI, homo_red*homo_red)
CALL cp_fm_struct_create(fm_struct_ab, para_env, context, dimen_RI, virt_red*virt_red)
CALL cp_fm_create(fm_mat_S_trunc, fm_struct_ia, "fm_S_trunc")
CALL cp_fm_create(fm_mat_S_ij_trunc, fm_struct_ij, "fm_S_ij_trunc")
CALL cp_fm_create(fm_mat_S_ab_trunc, fm_struct_ab, "fm_S_ab_trunc")
CALL cp_fm_create(fm_mat_S_trunc, fm_struct_ia, name="fm_S_trunc", set_zero=.TRUE.)
CALL cp_fm_create(fm_mat_S_ij_trunc, fm_struct_ij, name="fm_S_ij_trunc", set_zero=.TRUE.)
CALL cp_fm_create(fm_mat_S_ab_trunc, fm_struct_ab, name="fm_S_ab_trunc", set_zero=.TRUE.)
!Copy parts of original matrices to truncated ones
IF (mp2_env%bse%bse_cutoff_occ > 0 .OR. mp2_env%bse%bse_cutoff_empty > 0) THEN

11
src/fm/cp_cfm_types.F
View file

@ -114,13 +114,15 @@ CONTAINS
!> \param matrix matrix to be created
!> \param matrix_struct structure of the matrix
!> \param name name of the matrix
!> \param set_zero ...
!> \note
!> preferred allocation routine
! **************************************************************************************************
SUBROUTINE cp_cfm_create(matrix, matrix_struct, name)
SUBROUTINE cp_cfm_create(matrix, matrix_struct, name, set_zero)
TYPE(cp_cfm_type), INTENT(OUT) :: matrix
TYPE(cp_fm_struct_type), INTENT(IN), TARGET :: matrix_struct
CHARACTER(len=*), INTENT(in), OPTIONAL :: name
LOGICAL, INTENT(in), OPTIONAL :: set_zero
INTEGER :: ncol_local, npcol, nprow, nrow_local
TYPE(cp_blacs_env_type), POINTER :: context
@ -137,8 +139,11 @@ CONTAINS
ncol_local = MAX(1, matrix_struct%ncol_locals(context%mepos(2)))
ALLOCATE (matrix%local_data(nrow_local, ncol_local))
! do not initialise created matrix as it is up to the user to do so
!CALL zcopy(nrow_local*ncol_local, z_zero, 0, matrix%local_data, 1)
IF (PRESENT(set_zero)) THEN
IF (set_zero) THEN
matrix%local_data(1:nrow_local, 1:ncol_local) = z_zero
END IF
END IF
IF (PRESENT(name)) THEN
matrix%name = name

2
src/fm/cp_fm_pool_types.F
View file

@ -197,7 +197,7 @@ CONTAINS
element = el
DEALLOCATE (el)
ELSE
CALL cp_fm_create(element, matrix_struct=pool%el_struct)
CALL cp_fm_create(element, matrix_struct=pool%el_struct, set_zero=.TRUE.)
END IF
IF (PRESENT(name)) THEN

69
src/fm/cp_fm_types.F
View file

@ -55,6 +55,7 @@ MODULE cp_fm_types
cp_fm_get_element, &
cp_fm_get_diag, & ! get diagonal
cp_fm_set_all, & ! set all elements and diagonal
cp_fm_set_all_submatrix, & ! set a submatrix to a given value
cp_fm_set_submatrix, & ! set a submatrix to given values
cp_fm_get_submatrix, & ! get a submatrix of given values
cp_fm_init_random, &
@ -154,17 +155,18 @@ CONTAINS
!> \param matrix_struct the structure of matrix
!> \param name ...
!> \param use_sp ...
!> \param set_zero ...
!> \par History
!> 08.2002 created [fawzi]
!> \author Fawzi Mohamed
!> \note
!> preferred allocation routine
! **************************************************************************************************
SUBROUTINE cp_fm_create(matrix, matrix_struct, name, use_sp)
SUBROUTINE cp_fm_create(matrix, matrix_struct, name, use_sp, set_zero)
TYPE(cp_fm_type), INTENT(OUT) :: matrix
TYPE(cp_fm_struct_type), INTENT(IN), TARGET :: matrix_struct
CHARACTER(LEN=*), INTENT(in), OPTIONAL :: name
LOGICAL, INTENT(in), OPTIONAL :: use_sp
LOGICAL, INTENT(in), OPTIONAL :: use_sp, set_zero
CHARACTER(LEN=*), PARAMETER :: routineN = 'cp_fm_create'
@ -197,11 +199,14 @@ CONTAINS
ALLOCATE (matrix%local_data(nrow_local, ncol_local))
END IF
! JVDV we should remove this, as it is up to the user to zero afterwards
IF (matrix%use_sp) THEN
matrix%local_data_sp(1:nrow_local, 1:ncol_local) = 0.0_sp
ELSE
matrix%local_data(1:nrow_local, 1:ncol_local) = 0.0_dp
IF (PRESENT(set_zero)) THEN
IF (set_zero) THEN
IF (matrix%use_sp) THEN
matrix%local_data_sp(1:nrow_local, 1:ncol_local) = 0.0_sp
ELSE
matrix%local_data(1:nrow_local, 1:ncol_local) = 0.0_dp
END IF
END IF
END IF
IF (PRESENT(name)) THEN
@ -864,6 +869,56 @@ CONTAINS
END SUBROUTINE cp_fm_set_submatrix
! **************************************************************************************************
!> \brief sets a submatrix of a full matrix to a given value
!> fm(start_row:start_row+n_rows,start_col:start_col+n_cols) = value
!> \param fm the full to change
!> \param new_value ...
!> \param start_row the starting row of matrix
!> \param start_col the starting col of matrix
!> \param n_rows the number of rows to change
!> \param n_cols the number of columns to change
!> \par History
!> 07.2002 created borrowing from Joost's blacs_replicated_copy [fawzi]
!> 12.2025 created from cp_fm_set_submatrix
!> \author JGH
! **************************************************************************************************
SUBROUTINE cp_fm_set_all_submatrix(fm, new_value, start_row, start_col, n_rows, n_cols)
TYPE(cp_fm_type), INTENT(IN) :: fm
REAL(KIND=dp), INTENT(in) :: new_value
INTEGER, INTENT(in) :: start_row, start_col, n_rows, n_cols
INTEGER :: i, i0, j, j0, ncol_global, ncol_local, &
nrow_global, nrow_local, this_col, &
this_row
INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
REAL(KIND=dp), DIMENSION(:, :), POINTER :: full_block
CPASSERT(.NOT. fm%use_sp)
full_block => fm%local_data
CALL cp_fm_get_info(matrix=fm, &
nrow_global=nrow_global, ncol_global=ncol_global, &
nrow_local=nrow_local, ncol_local=ncol_local, &
row_indices=row_indices, col_indices=col_indices)
i0 = start_row
j0 = start_col
DO j = 1, ncol_local
this_col = col_indices(j) - j0 + 1
IF (this_col >= 1 .AND. this_col <= n_cols) THEN
DO i = 1, nrow_local
this_row = row_indices(i) - i0 + 1
IF (this_row >= 1 .AND. this_row <= n_rows) THEN
full_block(i, j) = new_value
END IF
END DO
END IF
END DO
END SUBROUTINE cp_fm_set_all_submatrix
! **************************************************************************************************
!> \brief gets a submatrix of a full matrix
!> op(target_m)(1:n_rows,1:n_cols)

2
src/gw_large_cell_gamma.F
View file

@ -1514,7 +1514,7 @@ CONTAINS
ALLOCATE (fm_W_MIC_time(bs_env%num_time_freq_points))
DO i_t = 1, bs_env%num_time_freq_points
CALL cp_fm_create(fm_W_MIC_time(i_t), bs_env%fm_RI_RI%matrix_struct)
CALL cp_fm_create(fm_W_MIC_time(i_t), bs_env%fm_RI_RI%matrix_struct, set_zero=.TRUE.)
END DO
CALL timestop(handle)

3
src/gw_utils.F
View file

@ -1721,7 +1721,8 @@ CONTAINS
DO img = 1, dft_control%nimages
! safe fm_V_xc_R in fm_matrix because saving in dbcsr matrix caused trouble...
CALL copy_dbcsr_to_fm(matrix_ks_kp(ispin, img)%matrix, bs_env%fm_work_mo(1))
CALL cp_fm_create(bs_env%fm_V_xc_R(img, ispin), bs_env%fm_work_mo(1)%matrix_struct)
CALL cp_fm_create(bs_env%fm_V_xc_R(img, ispin), bs_env%fm_work_mo(1)%matrix_struct, &
set_zero=.TRUE.)
! store h_ks(v_xc = 0) in fm_V_xc_R
CALL cp_fm_scale_and_add(alpha=1.0_dp, matrix_a=bs_env%fm_V_xc_R(img, ispin), &
beta=1.0_dp, matrix_b=bs_env%fm_work_mo(1))

2
src/mp2_ri_grad.F
View file

@ -1336,7 +1336,7 @@ CONTAINS
CALL cp_fm_struct_create(fm_struct_tmp, para_env=para_env, context=blacs_env, &
nrow_global=homo, ncol_global=virtual)
CALL cp_fm_create(mp2_env%ri_grad%L_jb(kspin), fm_struct_tmp, name="fm_L_jb")
CALL cp_fm_create(mp2_env%ri_grad%L_jb(kspin), fm_struct_tmp, name="fm_L_jb", set_zero=.TRUE.)
CALL cp_fm_struct_release(fm_struct_tmp)
! first Virtual

16
src/parallel_gemm_api.F
View file

@ -21,6 +21,7 @@ MODULE parallel_gemm_api
USE cp_cfm_types, ONLY: cp_cfm_type
USE cp_fm_basic_linalg, ONLY: cp_fm_gemm
USE cp_fm_types, ONLY: cp_fm_get_mm_type,&
cp_fm_set_all_submatrix,&
cp_fm_type
USE input_constants, ONLY: do_cosma,&
do_scalapack
@ -75,7 +76,10 @@ CONTAINS
CHARACTER(len=*), PARAMETER :: routineN = 'parallel_gemm_fm'
INTEGER :: handle, my_multi
INTEGER :: cfc, cfr, handle, my_multi
MARK_USED(cfc)
MARK_USED(cfr)
my_multi = cp_fm_get_mm_type()
@ -92,6 +96,16 @@ CONTAINS
CASE (do_cosma)
#if defined(__COSMA)
CALL timeset(routineN//"_cosma", handle)
!> This seems not to be correct in COSMA! See BLAS definition:
!> On entry, BETA specifies the scalar beta. When BETA is
!> supplied as zero then C need not be set on input.
IF (beta == 0.0_dp) THEN
cfr = 1
cfc = 1
IF (PRESENT(c_first_row)) cfr = c_first_row
IF (PRESENT(c_first_col)) cfc = c_first_col
CALL cp_fm_set_all_submatrix(matrix_c, 0.0_dp, cfr, cfc, m, n)
END IF
CALL offload_activate_chosen_device()
CALL cosma_pdgemm(transa=transa, transb=transb, m=m, n=n, k=k, alpha=alpha, &
matrix_a=matrix_a, matrix_b=matrix_b, beta=beta, matrix_c=matrix_c, &

8
src/qs_dcdr.F
View file

@ -311,13 +311,13 @@ CONTAINS
psi0_order(ispin) = mo_coeff
END DO
DO ispin = 1, dcdr_env%nspins
CALL cp_fm_set_all(psi1(ispin), 0.0_dp)
CALL cp_fm_set_all(h1_psi0(ispin), 0.0_dp)
END DO
! Restart
IF (linres_control%linres_restart) THEN
CALL dcdr_read_restart(qs_env, lr_section, psi1, dcdr_env%lambda, dcdr_env%beta, "dCdR")
ELSE
DO ispin = 1, dcdr_env%nspins
CALL cp_fm_set_all(psi1(ispin), 0.0_dp)
END DO
END IF
IF (output_unit > 0) THEN

11
src/qs_dcdr_utils.F
View file

@ -228,6 +228,7 @@ CONTAINS
CALL cp_fm_get_info(mo_coeff, nrow_global=nao, ncol_block=max_block)
ALLOCATE (vecbuffer(nao, max_block))
vecbuffer = 0.0_dp
!
! read headers
IF (rst_unit > 0) READ (rst_unit, IOSTAT=iostat) lambda_tmp, beta_tmp, nspins_tmp, nao_tmp
@ -847,11 +848,11 @@ CONTAINS
ALLOCATE (dcdr_env%op_dR(nspins))
DO ispin = 1, nspins
CALL cp_fm_create(dcdr_env%dCR(ispin), dcdr_env%likemos_fm_struct(ispin)%struct)
CALL cp_fm_create(dcdr_env%dCR_prime(ispin), dcdr_env%likemos_fm_struct(ispin)%struct)
CALL cp_fm_create(dcdr_env%mo_coeff(ispin), dcdr_env%likemos_fm_struct(ispin)%struct)
CALL cp_fm_create(dcdr_env%chc(ispin), dcdr_env%momo_fm_struct(ispin)%struct)
CALL cp_fm_create(dcdr_env%op_dR(ispin), dcdr_env%likemos_fm_struct(ispin)%struct)
CALL cp_fm_create(dcdr_env%dCR(ispin), dcdr_env%likemos_fm_struct(ispin)%struct, set_zero=.TRUE.)
CALL cp_fm_create(dcdr_env%dCR_prime(ispin), dcdr_env%likemos_fm_struct(ispin)%struct, set_zero=.TRUE.)
CALL cp_fm_create(dcdr_env%mo_coeff(ispin), dcdr_env%likemos_fm_struct(ispin)%struct, set_zero=.TRUE.)
CALL cp_fm_create(dcdr_env%chc(ispin), dcdr_env%momo_fm_struct(ispin)%struct, set_zero=.TRUE.)
CALL cp_fm_create(dcdr_env%op_dR(ispin), dcdr_env%likemos_fm_struct(ispin)%struct, set_zero=.TRUE.)
CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff)
CALL cp_fm_to_fm(mo_coeff, dcdr_env%mo_coeff(ispin))

25
src/qs_density_matrices.F
View file

@ -233,7 +233,7 @@ CONTAINS
CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=ncol_global, ncol_global=ncol_global, &
para_env=mo_set%mo_coeff%matrix_struct%para_env, &
context=mo_set%mo_coeff%matrix_struct%context)
CALL cp_fm_create(h_block, fm_struct_tmp, name="h block")
CALL cp_fm_create(h_block, fm_struct_tmp, name="h block", set_zero=.TRUE.)
IF (do_symm) CALL cp_fm_create(h_block_t, fm_struct_tmp, name="h block t")
CALL cp_fm_struct_release(fm_struct_tmp)
@ -371,24 +371,9 @@ CONTAINS
CALL timeset(routineN, handle)
! CALL cp_fm_get_info(matrix=mo_set%mo_coeff, ncol_global=ncol, nrow_global=nrow)
! CALL cp_fm_create(scrv, mo_set%mo_coeff%matrix_struct, "scr vectors")
! CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=ncol, ncol_global=ncol, &
! para_env=mo_set%mo_coeff%matrix_struct%para_env, &
! context=mo_set%mo_coeff%matrix_struct%context)
! CALL cp_fm_create(ksmat, fm_struct_tmp, name="KS")
! CALL cp_fm_struct_release(fm_struct_tmp)
! CALL cp_dbcsr_sm_fm_multiply(ks_matrix, mo_set%mo_coeff, scrv, ncol)
! CALL parallel_gemm("T", "N", ncol, ncol, nrow, 1.0_dp, mo_set%mo_coeff, scrv, 0.0_dp, ksmat)
! CALL parallel_gemm("N", "N", nrow, ncol, ncol, 1.0_dp, mo_set%mo_coeff, ksmat, 0.0_dp, scrv)
! CALL dbcsr_set(w_matrix, 0.0_dp)
! CALL cp_dbcsr_plus_fm_fm_t(w_matrix, matrix_v=scrv, matrix_g=psi1, &
! ncol=mo_set%homo, symmetry_mode=1)
! CALL cp_fm_release(scrv)
! CALL cp_fm_release(ksmat)
CALL cp_fm_get_info(matrix=mo_set%mo_coeff, ncol_global=ncol, nrow_global=nrow)
nocc = mo_set%homo
CALL cp_fm_create(scrv, mo_set%mo_coeff%matrix_struct, "scr vectors")
CALL cp_fm_create(scrv, mo_set%mo_coeff%matrix_struct, "scr vectors", set_zero=.TRUE.)
CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=nocc, ncol_global=nocc, &
para_env=mo_set%mo_coeff%matrix_struct%para_env, &
context=mo_set%mo_coeff%matrix_struct%context)
@ -436,7 +421,7 @@ CONTAINS
falpha = focc
CALL cp_fm_create(hcvec, c0vec%matrix_struct, "hcvec")
CALL cp_fm_create(hcvec, c0vec%matrix_struct, name="hcvec", set_zero=.TRUE.)
CALL cp_fm_get_info(hcvec, matrix_struct=fm_struct, nrow_global=nao, ncol_global=norb)
CPASSERT(nocc <= norb .AND. nocc > 0)
norb = nocc
@ -482,7 +467,7 @@ CONTAINS
CALL timeset(routineN, handle)
CALL cp_fm_get_info(matrix=mos_active, ncol_global=ncol, nrow_global=nrow)
CALL cp_fm_create(scrv, mos_active%matrix_struct, "scr vectors")
CALL cp_fm_create(scrv, mos_active%matrix_struct, name="scr vectors", set_zero=.TRUE.)
CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=ncol, ncol_global=ncol, &
para_env=mos_active%matrix_struct%para_env, &
context=mos_active%matrix_struct%context)
@ -526,7 +511,7 @@ CONTAINS
CALL timeset(routineN, handle)
CALL cp_fm_get_info(matrix=mos_active, ncol_global=ncol, nrow_global=nrow)
CALL cp_fm_create(scrv, mos_active%matrix_struct, "scr vectors")
CALL cp_fm_create(scrv, mos_active%matrix_struct, name="scr vectors", set_zero=.TRUE.)
CALL cp_fm_struct_create(fm_struct_tmp, nrow_global=ncol, ncol_global=ncol, &
para_env=mos_active%matrix_struct%para_env, &
context=mos_active%matrix_struct%context)

12
src/qs_linres_current.F
View file

@ -2418,13 +2418,13 @@ CONTAINS
ncol_global=max_states, para_env=para_env, &
context=mo_coeff%matrix_struct%context)
DO idir = 1, 3
CALL cp_fm_create(p_rxp(idir), tmp_fm_struct)
CALL cp_fm_create(r_p1(idir), tmp_fm_struct)
CALL cp_fm_create(r_p2(idir), tmp_fm_struct)
CALL cp_fm_create(p_rxp(idir), tmp_fm_struct, set_zero=.TRUE.)
CALL cp_fm_create(r_p1(idir), tmp_fm_struct, set_zero=.TRUE.)
CALL cp_fm_create(r_p2(idir), tmp_fm_struct, set_zero=.TRUE.)
DO idir2 = 1, 9
CALL cp_fm_create(rr_rxp(idir2, idir), tmp_fm_struct)
CALL cp_fm_create(rr_p1(idir2, idir), tmp_fm_struct)
CALL cp_fm_create(rr_p2(idir2, idir), tmp_fm_struct)
CALL cp_fm_create(rr_rxp(idir2, idir), tmp_fm_struct, set_zero=.TRUE.)
CALL cp_fm_create(rr_p1(idir2, idir), tmp_fm_struct, set_zero=.TRUE.)
CALL cp_fm_create(rr_p2(idir2, idir), tmp_fm_struct, set_zero=.TRUE.)
END DO
END DO
CALL cp_fm_struct_release(tmp_fm_struct)

2
src/qs_linres_methods.F
View file

@ -297,7 +297,7 @@ CONTAINS
CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nmo, &
ncol_global=nmo, para_env=para_env, &
context=mo_coeff%matrix_struct%context)
CALL cp_fm_create(chc(ispin), tmp_fm_struct)
CALL cp_fm_create(chc(ispin), tmp_fm_struct, set_zero=.TRUE.)
CALL cp_fm_struct_release(tmp_fm_struct)
END DO
!

11
src/qs_linres_polar_utils.F
View file

@ -447,17 +447,16 @@ CONTAINS
CALL get_polar_env(polar_env=polar_env, &
psi1_dBerry=psi1_dBerry, &
dBerry_psi0=dBerry_psi0)
DO idir = 1, 3
DO ispin = 1, nspins
CALL cp_fm_set_all(psi1_dBerry(idir, ispin), 0.0_dp)
END DO
END DO
! Restart
IF (linres_control%linres_restart) THEN
DO idir = 1, 3
CALL linres_read_restart(qs_env, lr_section, psi1_dBerry(idir, :), idir, "psi1_dBerry")
END DO
ELSE
DO idir = 1, 3
DO ispin = 1, nspins
CALL cp_fm_set_all(psi1_dBerry(idir, ispin), 0.0_dp)
END DO
END DO
END IF
loop_idir: DO idir = 1, 3
IF (iounit > 0) THEN

2
src/qs_mfp.F
View file

@ -1188,7 +1188,7 @@ CONTAINS
! allocate the vectors
ASSOCIATE (psi0_order => vcd_env%dcdr_env%mo_coeff)
CALL cp_fm_create(psi1(1), vcd_env%dcdr_env%likemos_fm_struct(1)%struct)
CALL cp_fm_create(psi1(1), vcd_env%dcdr_env%likemos_fm_struct(1)%struct, set_zero=.TRUE.)
CALL cp_fm_create(h1_psi0(1), vcd_env%dcdr_env%likemos_fm_struct(1)%struct)
! Restart

2
src/qs_mo_methods.F
View file

@ -103,7 +103,7 @@ CONTAINS
CALL cp_fm_get_info(matrix=vmatrix, nrow_global=n, ncol_global=ncol_global)
IF (ncol > ncol_global) CPABORT("Wrong ncol value")
CALL cp_fm_create(svmatrix, vmatrix%matrix_struct, "SV")
CALL cp_fm_create(svmatrix, vmatrix%matrix_struct, "SV", set_zero=.TRUE.)
CALL cp_dbcsr_sm_fm_multiply(matrix_s, vmatrix, svmatrix, ncol)
NULLIFY (fm_struct_tmp)

2
src/qs_mo_types.F
View file

@ -32,6 +32,7 @@ MODULE qs_mo_types
USE cp_fm_types, ONLY: cp_fm_create,&
cp_fm_get_info,&
cp_fm_release,&
cp_fm_set_all,&
cp_fm_to_fm,&
cp_fm_type
USE kinds, ONLY: dp
@ -268,6 +269,7 @@ CONTAINS
CPASSERT(ASSOCIATED(fm_struct))
CALL cp_fm_create(mo_set%mo_coeff, fm_struct, name=name)
END IF
CALL cp_fm_set_all(mo_set%mo_coeff, 0.0_dp)
CALL cp_fm_get_info(mo_set%mo_coeff, nrow_global=nao, ncol_global=nmo)
CPASSERT(nao >= mo_set%nao)

4
src/qs_tddfpt2_eigensolver.F
View file

@ -611,8 +611,8 @@ CONTAINS
CALL cp_fm_get_info(krylov_vects(1, 1), context=blacs_env_global)
CALL cp_fm_struct_create(fm_struct, nrow_global=nkvs, ncol_global=nkvs, context=blacs_env_global)
CALL cp_fm_create(Atilde_fm, fm_struct)
CALL cp_fm_create(evects_Atilde_fm, fm_struct)
CALL cp_fm_create(Atilde_fm, fm_struct, set_zero=.TRUE.)
CALL cp_fm_create(evects_Atilde_fm, fm_struct, set_zero=.TRUE.)
CALL cp_fm_struct_release(fm_struct)
! *** compute upper-diagonal reduced action matrix ***

8
src/qs_tddfpt2_soc.F
View file

@ -1459,9 +1459,9 @@ CONTAINS
nrow_global=ntot, ncol_global=1)
CALL cp_cfm_get_info(soc_evecs_cfm, matrix_struct=full_struct)
CALL cp_cfm_create(dip_cfm, dip_struct)
CALL cp_cfm_create(work1_cfm, full_struct)
CALL cp_cfm_create(work2_cfm, full_struct)
CALL cp_cfm_create(dip_cfm, dip_struct, set_zero=.TRUE.)
CALL cp_cfm_create(work1_cfm, full_struct, set_zero=.TRUE.)
CALL cp_cfm_create(work2_cfm, full_struct, set_zero=.TRUE.)
ALLOCATE (transdip(ntot, 1))
@ -1601,7 +1601,7 @@ CONTAINS
nrow_global=ntot, ncol_global=ntot)
ALLOCATE (amew_op(dim_op))
DO i = 1, dim_op
CALL cp_fm_create(amew_op(i), full_struct)
CALL cp_fm_create(amew_op(i), full_struct, set_zero=.TRUE.)
END DO !i
! Deal with the GS-GS contribution <0|0> = 2*sum_j <phi_j|op|phi_j>

4
src/qs_vcd.F
View file

@ -625,7 +625,7 @@ CONTAINS
deltaR => vcd_env%dcdr_env%deltaR)
! build the full matrices
CALL cp_fm_create(buf, vcd_env%dcdr_env%likemos_fm_struct(ispin)%struct)
CALL cp_fm_create(buf, vcd_env%dcdr_env%likemos_fm_struct(ispin)%struct, set_zero=.TRUE.)
CALL cp_fm_create(matrix_dSdV_mo, vcd_env%dcdr_env%momo_fm_struct(ispin)%struct)
! STEP 1: dCV contribution (dipvel + commutator)
@ -1073,7 +1073,7 @@ CONTAINS
END IF
ASSOCIATE (psi0_order => vcd_env%dcdr_env%mo_coeff)
CALL cp_fm_create(psi1(ispin), vcd_env%dcdr_env%likemos_fm_struct(ispin)%struct)
CALL cp_fm_create(psi1(ispin), vcd_env%dcdr_env%likemos_fm_struct(ispin)%struct, set_zero=.TRUE.)
CALL cp_fm_create(h1_psi0(ispin), vcd_env%dcdr_env%likemos_fm_struct(ispin)%struct)
! Restart

12
src/qs_vcd_utils.F
View file

@ -220,17 +220,17 @@ CONTAINS
ALLOCATE (vcd_env%op_dV(nspins))
ALLOCATE (vcd_env%op_dB(nspins))
DO ispin = 1, nspins
CALL cp_fm_create(vcd_env%dCV(ispin), vcd_env%dcdr_env%likemos_fm_struct(1)%struct)
CALL cp_fm_create(vcd_env%dCV_prime(ispin), vcd_env%dcdr_env%likemos_fm_struct(1)%struct)
CALL cp_fm_create(vcd_env%op_dV(ispin), vcd_env%dcdr_env%likemos_fm_struct(1)%struct)
CALL cp_fm_create(vcd_env%op_dB(ispin), vcd_env%dcdr_env%likemos_fm_struct(1)%struct)
CALL cp_fm_create(vcd_env%dCV(ispin), vcd_env%dcdr_env%likemos_fm_struct(1)%struct, set_zero=.TRUE.)
CALL cp_fm_create(vcd_env%dCV_prime(ispin), vcd_env%dcdr_env%likemos_fm_struct(1)%struct, set_zero=.TRUE.)
CALL cp_fm_create(vcd_env%op_dV(ispin), vcd_env%dcdr_env%likemos_fm_struct(1)%struct, set_zero=.TRUE.)
CALL cp_fm_create(vcd_env%op_dB(ispin), vcd_env%dcdr_env%likemos_fm_struct(1)%struct, set_zero=.TRUE.)
END DO
ALLOCATE (vcd_env%dCB(3))
ALLOCATE (vcd_env%dCB_prime(3))
DO i = 1, 3
CALL cp_fm_create(vcd_env%dCB(i), vcd_env%dcdr_env%likemos_fm_struct(1)%struct)
CALL cp_fm_create(vcd_env%dCB_prime(i), vcd_env%dcdr_env%likemos_fm_struct(1)%struct)
CALL cp_fm_create(vcd_env%dCB(i), vcd_env%dcdr_env%likemos_fm_struct(1)%struct, set_zero=.TRUE.)
CALL cp_fm_create(vcd_env%dCB_prime(i), vcd_env%dcdr_env%likemos_fm_struct(1)%struct, set_zero=.TRUE.)
END DO
! DBCSR matrices

4
src/qs_wf_history_methods.F
View file

@ -866,12 +866,12 @@ CONTAINS
nrow_global=n, &
ncol_global=k, &
matrix_struct=matrix_struct)
CALL cp_fm_create(fm_tmp, matrix_struct)
CALL cp_fm_create(fm_tmp, matrix_struct, set_zero=.TRUE.)
CALL cp_fm_struct_create(matrix_struct_new, &
template_fmstruct=matrix_struct, &
nrow_global=k, &
ncol_global=k)
CALL cp_fm_create(csc, matrix_struct_new)
CALL cp_fm_create(csc, matrix_struct_new, set_zero=.TRUE.)
CALL cp_fm_struct_release(matrix_struct_new)
! first the most recent
t1_state => wfi_get_snapshot(wf_history, &

2
src/rpa_grad.F
View file

@ -187,7 +187,7 @@ CONTAINS
ALLOCATE (rpa_grad%fm_Y(nspins))
DO ispin = 1, nspins
CALL cp_fm_create(rpa_grad%fm_Y(ispin), fm_mat_S(ispin)%matrix_struct)
CALL cp_fm_create(rpa_grad%fm_Y(ispin), fm_mat_S(ispin)%matrix_struct, set_zero=.TRUE.)
END DO
IF (do_ri_sos_laplace_mp2) THEN

2
src/rpa_gw.F
View file

@ -279,7 +279,7 @@ CONTAINS
DO jquad = 1, num_integ_points
CALL cp_fm_create(fm_mat_W(jquad), fm_mat_Q%matrix_struct)
CALL cp_fm_create(fm_mat_W(jquad), fm_mat_Q%matrix_struct, set_zero=.TRUE.)
CALL cp_fm_to_fm(fm_mat_Q, fm_mat_W(jquad))
CALL cp_fm_set_all(fm_mat_W(jquad), 0.0_dp)

2
src/rpa_main.F
View file

@ -969,7 +969,7 @@ CONTAINS
CALL cp_fm_struct_create(fm_struct, context=blacs_env_Q, nrow_global=dimen_RI, &
ncol_global=dimen_RI, para_env=para_env_RPA)
DO ispin = 1, SIZE(fm_mat_Q)
CALL cp_fm_create(fm_mat_Q(ispin), fm_struct, name="fm_mat_Q")
CALL cp_fm_create(fm_mat_Q(ispin), fm_struct, name="fm_mat_Q", set_zero=.TRUE.)
END DO
CALL cp_fm_struct_release(fm_struct)

4
src/s_square_methods.F
View file

@ -121,7 +121,7 @@ CONTAINS
CALL cp_fm_struct_release(fm_struct_tmp)
! Create S*C(beta)
CALL cp_fm_get_info(c_beta, matrix_struct=fm_struct_tmp)
CALL cp_fm_create(scb, fm_struct_tmp, name="S*C(beta)")
CALL cp_fm_create(scb, fm_struct_tmp, name="S*C(beta)", set_zero=.TRUE.)
! Compute S*C(beta)
CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, c_beta, scb, nbeta)
! Compute C(alpha)^T*S*C(beta)
@ -148,7 +148,7 @@ CONTAINS
CALL parallel_gemm('N', 'T', nao, nalpha, nbeta, -strength, scb, catscb, 1.0_dp, mo_derivs(1))
! Create S*C(alpha)
CALL cp_fm_get_info(c_alpha, matrix_struct=fm_struct_tmp)
CALL cp_fm_create(sca, fm_struct_tmp, name="S*C(alpha)")
CALL cp_fm_create(sca, fm_struct_tmp, name="S*C(alpha)", set_zero=.TRUE.)
! Compute S*C(alpha)
CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, c_alpha, sca, nalpha)
! Add -strength*S*C(alpha)*C(alpha)^T*S*C(beta) to the beta MO derivatives

24
src/xas_tdp_utils.F
View file

@ -1589,8 +1589,8 @@ CONTAINS
! Creating the real and the imaginary part of the SOC perturbation matrix
CALL cp_fm_struct_create(full_struct, context=blacs_env, para_env=para_env, &
nrow_global=ntot, ncol_global=ntot)
CALL cp_fm_create(real_fm, full_struct)
CALL cp_fm_create(img_fm, full_struct)
CALL cp_fm_create(real_fm, full_struct, set_zero=.TRUE.)
CALL cp_fm_create(img_fm, full_struct, set_zero=.TRUE.)
! Put the excitation energies on the diagonal of the real matrix. Element 1,1 is the ground state
DO isc = 1, nsc
@ -1722,7 +1722,7 @@ CONTAINS
! some more useful work matrices
CALL cp_fm_struct_create(work_struct, context=blacs_env, para_env=para_env, &
nrow_global=nex, ncol_global=nex)
CALL cp_fm_create(work_fm, work_struct)
CALL cp_fm_create(work_fm, work_struct, set_zero=.TRUE.)
! Looping over the excited states, computing the SOC and filling the perturbation matrix
! There are 3 loops to do: sc-sc, sc-sf and sf-sf
@ -2007,8 +2007,8 @@ CONTAINS
CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env)
CALL cp_fm_struct_create(full_struct, context=blacs_env, para_env=para_env, &
nrow_global=ntot, ncol_global=ntot)
CALL cp_fm_create(real_fm, full_struct)
CALL cp_fm_create(img_fm, full_struct)
CALL cp_fm_create(real_fm, full_struct, set_zero=.TRUE.)
CALL cp_fm_create(img_fm, full_struct, set_zero=.TRUE.)
! Put the excitation energies on the diagonal of the real matrix
DO isg = 1, nsg
@ -2406,7 +2406,7 @@ CONTAINS
nrow_global=ntot, ncol_global=ntot)
ALLOCATE (amew_op(dim_op))
DO i = 1, dim_op
CALL cp_fm_create(amew_op(i), full_struct)
CALL cp_fm_create(amew_op(i), full_struct, set_zero=.TRUE.)
END DO
! Before looping, need to evaluate sum_j,sigma <phi^0_j,sgima|op|phi^0_j,sigma>, for each dimension
@ -2419,8 +2419,8 @@ CONTAINS
CALL cp_fm_get_info(mo_coeff, matrix_struct=vec_struct)
CALL cp_fm_struct_create(prod_struct, context=blacs_env, para_env=para_env, &
nrow_global=homo, ncol_global=homo)
CALL cp_fm_create(vec_work, vec_struct)
CALL cp_fm_create(prod_work, prod_struct)
CALL cp_fm_create(vec_work, vec_struct, set_zero=.TRUE.)
CALL cp_fm_create(prod_work, prod_struct, set_zero=.TRUE.)
DO i = 1, dim_op
@ -2637,7 +2637,7 @@ CONTAINS
nrow_global=ntot, ncol_global=ntot)
ALLOCATE (amew_op(dim_op))
DO i = 1, dim_op
CALL cp_fm_create(amew_op(i), full_struct)
CALL cp_fm_create(amew_op(i), full_struct, set_zero=.TRUE.)
END DO !i
! Deal with the GS-GS contribution <0|0> = 2*sum_j <phi_j|op|phi_j>
@ -2994,9 +2994,9 @@ CONTAINS
CALL cp_fm_struct_create(dip_struct, context=blacs_env, para_env=para_env, &
nrow_global=ntot, ncol_global=1)
CALL cp_cfm_get_info(soc_evecs_cfm, matrix_struct=full_struct)
CALL cp_cfm_create(dip_cfm, dip_struct)
CALL cp_cfm_create(work1_cfm, full_struct)
CALL cp_cfm_create(work2_cfm, full_struct)
CALL cp_cfm_create(dip_cfm, dip_struct, set_zero=.TRUE.)
CALL cp_cfm_create(work1_cfm, full_struct, set_zero=.TRUE.)
CALL cp_cfm_create(work2_cfm, full_struct, set_zero=.TRUE.)
ALLOCATE (transdip(ntot, 1))
!get the dipole in the AMEW basis