From d22e34f677e3e97fc361d954cbe7ee933464fd17 Mon Sep 17 00:00:00 2001 From: rybkinjr Date: Mon, 17 Jun 2019 11:58:55 +0200 Subject: [PATCH] debug embed --- src/qs_environment_types.F | 380 ++++++++++++++++++------------------- src/qs_resp.F | 2 +- 2 files changed, 191 insertions(+), 191 deletions(-) diff --git a/src/qs_environment_types.F b/src/qs_environment_types.F index f1165fe1dd..8bf35a2b09 100644 --- a/src/qs_environment_types.F +++ b/src/qs_environment_types.F @@ -1288,7 +1288,7 @@ CONTAINS ! Resp charges IF (PRESENT(rhs)) qs_env%rhs => rhs -END SUBROUTINE set_qs_env + END SUBROUTINE set_qs_env ! ************************************************************************************************** !> \brief allocates and intitializes a qs_env @@ -1298,15 +1298,15 @@ END SUBROUTINE set_qs_env !> 12.2002 created [fawzi] !> \author Fawzi Mohamed ! ************************************************************************************************** -SUBROUTINE qs_env_create(qs_env, globenv) + SUBROUTINE qs_env_create(qs_env, globenv) TYPE(qs_environment_type), POINTER :: qs_env TYPE(global_environment_type), OPTIONAL, POINTER :: globenv CHARACTER(len=*), PARAMETER :: routineN = 'qs_env_create', routineP = moduleN//':'//routineN - ALLOCATE (qs_env) - CALL init_qs_env(qs_env, globenv=globenv) -END SUBROUTINE qs_env_create + ALLOCATE (qs_env) + CALL init_qs_env(qs_env, globenv=globenv) + END SUBROUTINE qs_env_create ! ************************************************************************************************** !> \brief retains the given qs_env (see doc/ReferenceCounting.html) @@ -1315,15 +1315,15 @@ END SUBROUTINE qs_env_create !> 12.2002 created [fawzi] !> \author Fawzi Mohamed ! ************************************************************************************************** -SUBROUTINE qs_env_retain(qs_env) + SUBROUTINE qs_env_retain(qs_env) TYPE(qs_environment_type), POINTER :: qs_env CHARACTER(len=*), PARAMETER :: routineN = 'qs_env_retain', routineP = moduleN//':'//routineN - CPASSERT(ASSOCIATED(qs_env)) - CPASSERT(qs_env%ref_count > 0) - qs_env%ref_count = qs_env%ref_count+1 -END SUBROUTINE qs_env_retain + CPASSERT(ASSOCIATED(qs_env)) + CPASSERT(qs_env%ref_count > 0) + qs_env%ref_count = qs_env%ref_count+1 + END SUBROUTINE qs_env_retain ! ************************************************************************************************** !> \brief releases the given qs_env (see doc/ReferenceCounting.html) @@ -1333,200 +1333,200 @@ END SUBROUTINE qs_env_retain !> 06.2018 polar_env added (MK) !> \author Fawzi Mohamed ! ************************************************************************************************** -SUBROUTINE qs_env_release(qs_env) + SUBROUTINE qs_env_release(qs_env) TYPE(qs_environment_type), POINTER :: qs_env CHARACTER(len=*), PARAMETER :: routineN = 'qs_env_release', routineP = moduleN//':'//routineN INTEGER :: i - IF (ASSOCIATED(qs_env)) THEN - CPASSERT(qs_env%ref_count > 0) - qs_env%ref_count = qs_env%ref_count-1 - IF (qs_env%ref_count < 1) THEN - CALL cell_release(qs_env%super_cell) - IF (ASSOCIATED(qs_env%mos)) THEN - DO i = 1, SIZE(qs_env%mos) - CALL deallocate_mo_set(qs_env%mos(i)%mo_set) - END DO - DEALLOCATE (qs_env%mos) - END IF - IF (ASSOCIATED(qs_env%mos_aux_fit)) THEN - DO i = 1, SIZE(qs_env%mos_aux_fit) - CALL deallocate_mo_set(qs_env%mos_aux_fit(i)%mo_set) - END DO - DEALLOCATE (qs_env%mos_aux_fit) - END IF + IF (ASSOCIATED(qs_env)) THEN + CPASSERT(qs_env%ref_count > 0) + qs_env%ref_count = qs_env%ref_count-1 + IF (qs_env%ref_count < 1) THEN + CALL cell_release(qs_env%super_cell) + IF (ASSOCIATED(qs_env%mos)) THEN + DO i = 1, SIZE(qs_env%mos) + CALL deallocate_mo_set(qs_env%mos(i)%mo_set) + END DO + DEALLOCATE (qs_env%mos) + END IF + IF (ASSOCIATED(qs_env%mos_aux_fit)) THEN + DO i = 1, SIZE(qs_env%mos_aux_fit) + CALL deallocate_mo_set(qs_env%mos_aux_fit(i)%mo_set) + END DO + DEALLOCATE (qs_env%mos_aux_fit) + END IF - IF (ASSOCIATED(qs_env%mo_derivs)) THEN - DO I = 1, SIZE(qs_env%mo_derivs) - CALL dbcsr_release_p(qs_env%mo_derivs(I)%matrix) - ENDDO - DEALLOCATE (qs_env%mo_derivs) - ENDIF - - IF (ASSOCIATED(qs_env%mo_derivs_aux_fit)) THEN - DO I = 1, SIZE(qs_env%mo_derivs_aux_fit) - CALL cp_fm_release(qs_env%mo_derivs_aux_fit(I)%matrix) - ENDDO - DEALLOCATE (qs_env%mo_derivs_aux_fit) - ENDIF - - IF (ASSOCIATED(qs_env%mo_loc_history)) THEN - DO I = 1, SIZE(qs_env%mo_loc_history) - CALL cp_fm_release(qs_env%mo_loc_history(I)%matrix) - ENDDO - DEALLOCATE (qs_env%mo_loc_history) - ENDIF - IF (ASSOCIATED(qs_env%rtp)) THEN - CALL rt_prop_release(qs_env%rtp) - DEALLOCATE (qs_env%rtp) - END IF - IF (ASSOCIATED(qs_env%outer_scf_history)) THEN - DEALLOCATE (qs_env%outer_scf_history) - qs_env%outer_scf_ihistory = 0 - ENDIF - IF (ASSOCIATED(qs_env%gradient_history)) & - DEALLOCATE (qs_env%gradient_history) - IF (ASSOCIATED(qs_env%variable_history)) & - DEALLOCATE (qs_env%variable_history) - IF (ASSOCIATED(qs_env%oce)) CALL deallocate_oce_set(qs_env%oce) - IF (ASSOCIATED(qs_env%local_rho_set)) THEN - CALL local_rho_set_release(qs_env%local_rho_set) - END IF - IF (ASSOCIATED(qs_env%hartree_local)) THEN - CALL hartree_local_release(qs_env%hartree_local) - END IF - CALL scf_c_release(qs_env%scf_control) - CALL rel_c_release(qs_env%rel_control) - - IF (ASSOCIATED(qs_env%linres_control)) THEN - CALL linres_control_release(qs_env%linres_control) - END IF - - IF (ASSOCIATED(qs_env%almo_scf_env)) THEN - CALL almo_scf_env_release(qs_env%almo_scf_env) - ENDIF - - IF (ASSOCIATED(qs_env%ls_scf_env)) THEN - CALL ls_scf_release(qs_env%ls_scf_env) - ENDIF - CALL molecular_scf_guess_env_destroy(qs_env%molecular_scf_guess_env) - - IF (ASSOCIATED(qs_env%transport_env)) THEN - CALL transport_env_release(qs_env%transport_env) - ENDIF - - !Only if do_xas_calculation - IF (ASSOCIATED(qs_env%xas_env)) THEN - CALL xas_env_release(qs_env%xas_env) - END IF - CALL ewald_env_release(qs_env%ewald_env) - CALL ewald_pw_release(qs_env%ewald_pw) - IF (ASSOCIATED(qs_env%image_matrix)) THEN - DEALLOCATE (qs_env%image_matrix) - ENDIF - IF (ASSOCIATED(qs_env%ipiv)) THEN - DEALLOCATE (qs_env%ipiv) - ENDIF - IF (ASSOCIATED(qs_env%image_coeff)) THEN - DEALLOCATE (qs_env%image_coeff) - ENDIF - ! ZMP - IF (ASSOCIATED(qs_env%rho_external)) THEN - CALL qs_rho_release(qs_env%rho_external) - END IF - IF (ASSOCIATED(qs_env%external_vxc)) THEN - CALL pw_release(qs_env%external_vxc%pw) - DEALLOCATE (qs_env%external_vxc) - ENDIF - IF (ASSOCIATED(qs_env%mask)) THEN - CALL pw_release(qs_env%mask%pw) - DEALLOCATE (qs_env%mask) - ENDIF - IF (ASSOCIATED(qs_env%active_space)) THEN - CALL release_active_space_type(qs_env%active_space) - ENDIF - ! Embedding potentials if provided as input - IF (qs_env%given_embed_pot) THEN - CALL pw_release(qs_env%embed_pot%pw) - DEALLOCATE (qs_env%embed_pot) - IF (ASSOCIATED(qs_env%spin_embed_pot)) THEN - CALL pw_release(qs_env%spin_embed_pot%pw) - DEALLOCATE (qs_env%spin_embed_pot) + IF (ASSOCIATED(qs_env%mo_derivs)) THEN + DO I = 1, SIZE(qs_env%mo_derivs) + CALL dbcsr_release_p(qs_env%mo_derivs(I)%matrix) + ENDDO + DEALLOCATE (qs_env%mo_derivs) ENDIF - ENDIF - ! Polarisability tensor - CALL polar_env_release(qs_env%polar_env) + IF (ASSOCIATED(qs_env%mo_derivs_aux_fit)) THEN + DO I = 1, SIZE(qs_env%mo_derivs_aux_fit) + CALL cp_fm_release(qs_env%mo_derivs_aux_fit(I)%matrix) + ENDDO + DEALLOCATE (qs_env%mo_derivs_aux_fit) + ENDIF - CALL qs_charges_release(qs_env%qs_charges) - CALL qs_ks_release(qs_env%ks_env) - CALL qs_ks_qmmm_release(qs_env%ks_qmmm_env) - CALL wfi_release(qs_env%wf_history) - CALL scf_env_release(qs_env%scf_env) - CALL mpools_release(qs_env%mpools) - CALL mpools_release(qs_env%mpools_aux_fit) - CALL section_vals_release(qs_env%input) - CALL cp_ddapc_release(qs_env%cp_ddapc_env) - CALL cp_ddapc_ewald_release(qs_env%cp_ddapc_ewald) - CALL efield_berry_release(qs_env%efield) - IF (ASSOCIATED(qs_env%x_data)) THEN - CALL hfx_release(qs_env%x_data) - END IF - IF (ASSOCIATED(qs_env%et_coupling)) THEN - CALL et_coupling_release(qs_env%et_coupling) - END IF - IF (ASSOCIATED(qs_env%dftb_potential)) THEN - CALL qs_dftb_pairpot_release(qs_env%dftb_potential) - END IF - IF (ASSOCIATED(qs_env%se_taper)) THEN - CALL se_taper_release(qs_env%se_taper) - END IF - IF (ASSOCIATED(qs_env%se_store_int_env)) THEN - CALL semi_empirical_si_release(qs_env%se_store_int_env) - END IF - IF (ASSOCIATED(qs_env%se_nddo_mpole)) THEN - CALL nddo_mpole_release(qs_env%se_nddo_mpole) - END IF - IF (ASSOCIATED(qs_env%se_nonbond_env)) THEN - CALL fist_nonbond_env_release(qs_env%se_nonbond_env) - END IF - IF (ASSOCIATED(qs_env%admm_env)) THEN - CALL admm_env_release(qs_env%admm_env) - END IF - IF (ASSOCIATED(qs_env%lri_env)) THEN - CALL lri_env_release(qs_env%lri_env) - END IF - IF (ASSOCIATED(qs_env%lri_density)) THEN - CALL lri_density_release(qs_env%lri_density) - END IF - IF (ASSOCIATED(qs_env%mp2_env)) THEN - CALL mp2_env_release(qs_env%mp2_env) - END IF - IF (ASSOCIATED(qs_env%kg_env)) THEN - CALL kg_env_release(qs_env%kg_env) - END IF + IF (ASSOCIATED(qs_env%mo_loc_history)) THEN + DO I = 1, SIZE(qs_env%mo_loc_history) + CALL cp_fm_release(qs_env%mo_loc_history(I)%matrix) + ENDDO + DEALLOCATE (qs_env%mo_loc_history) + ENDIF + IF (ASSOCIATED(qs_env%rtp)) THEN + CALL rt_prop_release(qs_env%rtp) + DEALLOCATE (qs_env%rtp) + END IF + IF (ASSOCIATED(qs_env%outer_scf_history)) THEN + DEALLOCATE (qs_env%outer_scf_history) + qs_env%outer_scf_ihistory = 0 + ENDIF + IF (ASSOCIATED(qs_env%gradient_history)) & + DEALLOCATE (qs_env%gradient_history) + IF (ASSOCIATED(qs_env%variable_history)) & + DEALLOCATE (qs_env%variable_history) + IF (ASSOCIATED(qs_env%oce)) CALL deallocate_oce_set(qs_env%oce) + IF (ASSOCIATED(qs_env%local_rho_set)) THEN + CALL local_rho_set_release(qs_env%local_rho_set) + END IF + IF (ASSOCIATED(qs_env%hartree_local)) THEN + CALL hartree_local_release(qs_env%hartree_local) + END IF + CALL scf_c_release(qs_env%scf_control) + CALL rel_c_release(qs_env%rel_control) - ! dispersion - CALL qs_dispersion_release(qs_env%dispersion_env) + IF (ASSOCIATED(qs_env%linres_control)) THEN + CALL linres_control_release(qs_env%linres_control) + END IF - IF (ASSOCIATED(qs_env%WannierCentres)) THEN - DO i = 1, SIZE(qs_env%WannierCentres) - DEALLOCATE (qs_env%WannierCentres(i)%WannierHamDiag) - DEALLOCATE (qs_env%WannierCentres(i)%centres) - ENDDO - DEALLOCATE (qs_env%WannierCentres) - ENDIF - ! Resp charges - IF (ASSOCIATED(qs_env%rhs)) DEALLOCATE (qs_env%rhs) - ! now we are ready to deallocate the full structure - DEALLOCATE (qs_env) + IF (ASSOCIATED(qs_env%almo_scf_env)) THEN + CALL almo_scf_env_release(qs_env%almo_scf_env) + ENDIF + + IF (ASSOCIATED(qs_env%ls_scf_env)) THEN + CALL ls_scf_release(qs_env%ls_scf_env) + ENDIF + CALL molecular_scf_guess_env_destroy(qs_env%molecular_scf_guess_env) + + IF (ASSOCIATED(qs_env%transport_env)) THEN + CALL transport_env_release(qs_env%transport_env) + ENDIF + + !Only if do_xas_calculation + IF (ASSOCIATED(qs_env%xas_env)) THEN + CALL xas_env_release(qs_env%xas_env) + END IF + CALL ewald_env_release(qs_env%ewald_env) + CALL ewald_pw_release(qs_env%ewald_pw) + IF (ASSOCIATED(qs_env%image_matrix)) THEN + DEALLOCATE (qs_env%image_matrix) + ENDIF + IF (ASSOCIATED(qs_env%ipiv)) THEN + DEALLOCATE (qs_env%ipiv) + ENDIF + IF (ASSOCIATED(qs_env%image_coeff)) THEN + DEALLOCATE (qs_env%image_coeff) + ENDIF + ! ZMP + IF (ASSOCIATED(qs_env%rho_external)) THEN + CALL qs_rho_release(qs_env%rho_external) + END IF + IF (ASSOCIATED(qs_env%external_vxc)) THEN + CALL pw_release(qs_env%external_vxc%pw) + DEALLOCATE (qs_env%external_vxc) + ENDIF + IF (ASSOCIATED(qs_env%mask)) THEN + CALL pw_release(qs_env%mask%pw) + DEALLOCATE (qs_env%mask) + ENDIF + IF (ASSOCIATED(qs_env%active_space)) THEN + CALL release_active_space_type(qs_env%active_space) + ENDIF + ! Embedding potentials if provided as input + IF (qs_env%given_embed_pot) THEN + CALL pw_release(qs_env%embed_pot%pw) + DEALLOCATE (qs_env%embed_pot) + IF (ASSOCIATED(qs_env%spin_embed_pot)) THEN + CALL pw_release(qs_env%spin_embed_pot%pw) + DEALLOCATE (qs_env%spin_embed_pot) + ENDIF + ENDIF + + ! Polarisability tensor + CALL polar_env_release(qs_env%polar_env) + + CALL qs_charges_release(qs_env%qs_charges) + CALL qs_ks_release(qs_env%ks_env) + CALL qs_ks_qmmm_release(qs_env%ks_qmmm_env) + CALL wfi_release(qs_env%wf_history) + CALL scf_env_release(qs_env%scf_env) + CALL mpools_release(qs_env%mpools) + CALL mpools_release(qs_env%mpools_aux_fit) + CALL section_vals_release(qs_env%input) + CALL cp_ddapc_release(qs_env%cp_ddapc_env) + CALL cp_ddapc_ewald_release(qs_env%cp_ddapc_ewald) + CALL efield_berry_release(qs_env%efield) + IF (ASSOCIATED(qs_env%x_data)) THEN + CALL hfx_release(qs_env%x_data) + END IF + IF (ASSOCIATED(qs_env%et_coupling)) THEN + CALL et_coupling_release(qs_env%et_coupling) + END IF + IF (ASSOCIATED(qs_env%dftb_potential)) THEN + CALL qs_dftb_pairpot_release(qs_env%dftb_potential) + END IF + IF (ASSOCIATED(qs_env%se_taper)) THEN + CALL se_taper_release(qs_env%se_taper) + END IF + IF (ASSOCIATED(qs_env%se_store_int_env)) THEN + CALL semi_empirical_si_release(qs_env%se_store_int_env) + END IF + IF (ASSOCIATED(qs_env%se_nddo_mpole)) THEN + CALL nddo_mpole_release(qs_env%se_nddo_mpole) + END IF + IF (ASSOCIATED(qs_env%se_nonbond_env)) THEN + CALL fist_nonbond_env_release(qs_env%se_nonbond_env) + END IF + IF (ASSOCIATED(qs_env%admm_env)) THEN + CALL admm_env_release(qs_env%admm_env) + END IF + IF (ASSOCIATED(qs_env%lri_env)) THEN + CALL lri_env_release(qs_env%lri_env) + END IF + IF (ASSOCIATED(qs_env%lri_density)) THEN + CALL lri_density_release(qs_env%lri_density) + END IF + IF (ASSOCIATED(qs_env%mp2_env)) THEN + CALL mp2_env_release(qs_env%mp2_env) + END IF + IF (ASSOCIATED(qs_env%kg_env)) THEN + CALL kg_env_release(qs_env%kg_env) + END IF + + ! dispersion + CALL qs_dispersion_release(qs_env%dispersion_env) + + IF (ASSOCIATED(qs_env%WannierCentres)) THEN + DO i = 1, SIZE(qs_env%WannierCentres) + DEALLOCATE (qs_env%WannierCentres(i)%WannierHamDiag) + DEALLOCATE (qs_env%WannierCentres(i)%centres) + ENDDO + DEALLOCATE (qs_env%WannierCentres) + ENDIF + ! Resp charges + IF (ASSOCIATED(qs_env%rhs)) DEALLOCATE (qs_env%rhs) + ! now we are ready to deallocate the full structure + DEALLOCATE (qs_env) + END IF END IF - END IF - NULLIFY (qs_env) + NULLIFY (qs_env) -END SUBROUTINE qs_env_release + END SUBROUTINE qs_env_release END MODULE qs_environment_types diff --git a/src/qs_resp.F b/src/qs_resp.F index 0b441930d6..b7bd6dc1c7 100644 --- a/src/qs_resp.F +++ b/src/qs_resp.F @@ -145,7 +145,7 @@ CONTAINS output_unit INTEGER, ALLOCATABLE, DIMENSION(:) :: ipiv LOGICAL :: has_resp - REAL(KIND=dp), DIMENSION(:), POINTER :: rhs_to_save = > Null() + REAL(KIND=dp), DIMENSION(:), POINTER :: rhs_to_save TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(cell_type), POINTER :: cell TYPE(cp_logger_type), POINTER :: logger