Skip to content

Commit

Permalink
Remove cp_error_type (Vedran Miletic)
Browse files Browse the repository at this point in the history 
svn-origin-rev: 15915
  • Loading branch information
@oschuett
oschuett committed Sep 20, 2015
1 parent 65ac95d commit fbfeb0d
Show file tree
Hide file tree
Showing 798 changed files with 66,078 additions and 82,211 deletions.
232 changes: 101 additions & 131 deletions src/admm_dm_methods.F
View file

Large diffs are not rendered by default.

6 changes: 2 additions & 4 deletions src/admm_dm_types.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -96,20 +96,18 @@ END SUBROUTINE admm_dm_create
! *****************************************************************************
!> \brief Release a admm_dm type
!> \param admm_dm ...
!> \param error ...
!> \author Ole Schuett
! *****************************************************************************
SUBROUTINE admm_dm_release(admm_dm, error)
SUBROUTINE admm_dm_release(admm_dm)
TYPE(admm_dm_type), POINTER :: admm_dm
TYPE(cp_error_type), INTENT(inout) :: error

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

IF(.NOT. ASSOCIATED(admm_dm)) RETURN

IF(ASSOCIATED(admm_dm%matrix_a)) THEN
CALL cp_dbcsr_release(admm_dm%matrix_a, error)
CALL cp_dbcsr_release(admm_dm%matrix_a)
DEALLOCATE(admm_dm%matrix_a)
ENDIF

Expand Down
712 changes: 323 additions & 389 deletions src/admm_methods.F
View file

Large diffs are not rendered by default.

210 changes: 99 additions & 111 deletions src/admm_types.F
View file

Large diffs are not rendered by default.

94 changes: 41 additions & 53 deletions src/admm_utils.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,13 +45,11 @@ MODULE admm_utils
!> \param ispin ...
!> \param admm_env ...
!> \param ks_matrix ...
!> \param error ...
! *****************************************************************************
SUBROUTINE admm_correct_for_eigenvalues(ispin, admm_env, ks_matrix, error)
SUBROUTINE admm_correct_for_eigenvalues(ispin, admm_env, ks_matrix)
INTEGER, INTENT(IN) :: ispin
TYPE(admm_type), POINTER :: admm_env
TYPE(cp_dbcsr_type), POINTER :: ks_matrix
TYPE(cp_error_type), INTENT(INOUT) :: error

INTEGER :: nao_aux_fit, nao_orb
TYPE(cp_dbcsr_type), POINTER :: work
Expand All @@ -65,62 +63,58 @@ SUBROUTINE admm_correct_for_eigenvalues(ispin, admm_env, ks_matrix, error)
!* remove what has been added and add the correction
NULLIFY(work)
ALLOCATE(work)
CALL cp_dbcsr_init (work, error)
CALL cp_dbcsr_init (work)
CALL cp_dbcsr_create(work, 'work', &
cp_dbcsr_distribution(ks_matrix), dbcsr_type_symmetric, cp_dbcsr_row_block_sizes(ks_matrix),&
cp_dbcsr_col_block_sizes(ks_matrix), &
cp_dbcsr_get_data_size(ks_matrix),&
cp_dbcsr_get_data_type(ks_matrix), error=error)
cp_dbcsr_get_data_type(ks_matrix))

CALL cp_dbcsr_copy(work, ks_matrix, error=error)
CALL cp_dbcsr_set(work, 0.0_dp, error)
CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin)%matrix, work, keep_sparsity=.TRUE.,&
error=error)
CALL cp_dbcsr_copy(work, ks_matrix)
CALL cp_dbcsr_set(work, 0.0_dp)
CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin)%matrix, work, keep_sparsity=.TRUE.)

CALL cp_dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp, error)
CALL cp_dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp)

! ** calculate A^T*H_tilde*A
CALL cp_gemm('N','N',nao_aux_fit,nao_orb,nao_aux_fit,&
1.0_dp, admm_env%K(ispin)%matrix,admm_env%A, 0.0_dp,&
admm_env%work_aux_orb,error)
admm_env%work_aux_orb)
CALL cp_gemm('T','N',nao_orb,nao_orb,nao_aux_fit,&
1.0_dp, admm_env%A, admm_env%work_aux_orb ,0.0_dp,&
admm_env%H_corr(ispin)%matrix,error)
admm_env%H_corr(ispin)%matrix)

CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.,&
error=error)
CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.)

CALL cp_dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp, error)
CALL cp_dbcsr_deallocate_matrix(work,error)
CALL cp_dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp)
CALL cp_dbcsr_deallocate_matrix(work)

CASE(do_admm_purify_mo_diag)
!* remove what has been added and add the correction
NULLIFY(work)
ALLOCATE(work)
CALL cp_dbcsr_init (work, error)
CALL cp_dbcsr_init (work)
CALL cp_dbcsr_create(work, 'work', &
cp_dbcsr_distribution(ks_matrix), dbcsr_type_symmetric, cp_dbcsr_row_block_sizes(ks_matrix),&
cp_dbcsr_col_block_sizes(ks_matrix), cp_dbcsr_get_data_size(ks_matrix),&
cp_dbcsr_get_data_type(ks_matrix), error=error)
cp_dbcsr_get_data_type(ks_matrix))

CALL cp_dbcsr_copy(work, ks_matrix, error=error)
CALL cp_dbcsr_set(work, 0.0_dp, error)
CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin)%matrix, work, keep_sparsity=.TRUE.,&
error=error)
CALL cp_dbcsr_copy(work, ks_matrix)
CALL cp_dbcsr_set(work, 0.0_dp)
CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin)%matrix, work, keep_sparsity=.TRUE.)

! ** calculate A^T*H_tilde*A
CALL cp_gemm('N','N',nao_aux_fit,nao_orb,nao_aux_fit,&
1.0_dp, admm_env%K(ispin)%matrix,admm_env%A, 0.0_dp,&
admm_env%work_aux_orb,error)
admm_env%work_aux_orb)
CALL cp_gemm('T','N',nao_orb,nao_orb,nao_aux_fit,&
1.0_dp, admm_env%A, admm_env%work_aux_orb ,0.0_dp,&
admm_env%H_corr(ispin)%matrix,error)
admm_env%H_corr(ispin)%matrix)

CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.,&
error=error)
CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.)

CALL cp_dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp, error)
CALL cp_dbcsr_deallocate_matrix(work,error)
CALL cp_dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp)
CALL cp_dbcsr_deallocate_matrix(work)

CASE(do_admm_purify_mo_no_diag, do_admm_purify_none, do_admm_purify_cauchy)
! do nothing
Expand All @@ -135,13 +129,11 @@ END SUBROUTINE admm_correct_for_eigenvalues
!> \param ispin ...
!> \param admm_env ...
!> \param ks_matrix ...
!> \param error ...
! *****************************************************************************
SUBROUTINE admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_matrix, error)
SUBROUTINE admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_matrix)
INTEGER, INTENT(IN) :: ispin
TYPE(admm_type), POINTER :: admm_env
TYPE(cp_dbcsr_type), POINTER :: ks_matrix
TYPE(cp_error_type), INTENT(INOUT) :: error

INTEGER :: nao_aux_fit, nao_orb
TYPE(cp_dbcsr_type), POINTER :: work
Expand All @@ -155,46 +147,42 @@ SUBROUTINE admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_matrix, error)
!* remove what has been added and add the correction
NULLIFY(work)
ALLOCATE(work)
CALL cp_dbcsr_init (work, error)
CALL cp_dbcsr_init (work)
CALL cp_dbcsr_create(work, 'work', &
cp_dbcsr_distribution(ks_matrix), dbcsr_type_symmetric, cp_dbcsr_row_block_sizes(ks_matrix),&
cp_dbcsr_col_block_sizes(ks_matrix), cp_dbcsr_get_data_size(ks_matrix),&
cp_dbcsr_get_data_type(ks_matrix), error=error)
cp_dbcsr_get_data_type(ks_matrix))

CALL cp_dbcsr_copy(work, ks_matrix, error=error)
CALL cp_dbcsr_set(work, 0.0_dp, error)
CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.,&
error=error)
CALL cp_dbcsr_copy(work, ks_matrix)
CALL cp_dbcsr_set(work, 0.0_dp)
CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.)

CALL cp_dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp, error)
CALL cp_dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp)

CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.,&
error=error)
CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.)

CALL cp_dbcsr_set(work, 0.0_dp, error)
CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin)%matrix, work, keep_sparsity=.TRUE.,&
error=error)
CALL cp_dbcsr_set(work, 0.0_dp)
CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin)%matrix, work, keep_sparsity=.TRUE.)

CALL cp_dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp, error)
CALL cp_dbcsr_deallocate_matrix(work,error)
CALL cp_dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp)
CALL cp_dbcsr_deallocate_matrix(work)

CASE(do_admm_purify_mo_diag)
NULLIFY(work)
ALLOCATE(work)
CALL cp_dbcsr_init (work, error)
CALL cp_dbcsr_init (work)
CALL cp_dbcsr_create(work, 'work', &
cp_dbcsr_distribution(ks_matrix), dbcsr_type_symmetric, cp_dbcsr_row_block_sizes(ks_matrix),&
cp_dbcsr_col_block_sizes(ks_matrix), cp_dbcsr_get_data_size(ks_matrix),&
cp_dbcsr_get_data_type(ks_matrix), error=error)
cp_dbcsr_get_data_type(ks_matrix))

CALL cp_dbcsr_copy(work, ks_matrix, error=error)
CALL cp_dbcsr_set(work, 0.0_dp, error)
CALL cp_dbcsr_copy(work, ks_matrix)
CALL cp_dbcsr_set(work, 0.0_dp)

CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.,&
error=error)
CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.)

CALL cp_dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp, error)
CALL cp_dbcsr_deallocate_matrix(work,error)
CALL cp_dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp)
CALL cp_dbcsr_deallocate_matrix(work)

CASE(do_admm_purify_mo_no_diag, do_admm_purify_none, do_admm_purify_cauchy)
! do nothing
Expand Down
42 changes: 15 additions & 27 deletions src/al_system_types.F
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,15 +55,12 @@ MODULE al_system_types
!> \param al ...
!> \param simpar ...
!> \param section ...
!> \param error variable to control error logging, stopping,...
!> see module cp_error_handling
!> \author Noam Bernstein [noamb] 02.2012
! *****************************************************************************
SUBROUTINE al_init(al, simpar, section, error)
SUBROUTINE al_init(al, simpar, section)
TYPE(al_system_type), POINTER :: al
TYPE(simpar_type), POINTER :: simpar
TYPE(section_vals_type), POINTER :: section
TYPE(cp_error_type), INTENT(inout) :: error

CHARACTER(LEN=*), PARAMETER :: routineN = 'al_init', &
routineP = moduleN//':'//routineN
Expand All @@ -75,22 +72,19 @@ SUBROUTINE al_init(al, simpar, section, error)
al%dt_fact=1.0_dp
al%dt=simpar%dt
CALL cite_reference(Jones2011)
CALL section_vals_val_get(section,"TIMECON_NH",r_val=al%tau_nh,error=error)
CALL section_vals_val_get(section,"TIMECON_LANGEVIN",r_val=al%tau_langevin,error=error)
CALL create_map_info_type(al%map_info, error)
CALL section_vals_val_get(section,"TIMECON_NH",r_val=al%tau_nh)
CALL section_vals_val_get(section,"TIMECON_LANGEVIN",r_val=al%tau_langevin)
CALL create_map_info_type(al%map_info)

END SUBROUTINE al_init

! *****************************************************************************
!> \brief Initialize NVT type for AD_LANGEVIN thermostat
!> \param al ...
!> \param error variable to control error logging, stopping,...
!> see module cp_error_handling
!> \author Noam Bernstein [noamb] 02.2012
! *****************************************************************************
SUBROUTINE al_thermo_create(al, error)
SUBROUTINE al_thermo_create(al)
TYPE(al_system_type), POINTER :: al
TYPE(cp_error_type), INTENT(inout) :: error

CHARACTER(LEN=*), PARAMETER :: routineN = 'al_thermo_create', &
routineP = moduleN//':'//routineN
Expand All @@ -101,30 +95,27 @@ SUBROUTINE al_thermo_create(al, error)
DIMENSION(:, :, :) :: seed

failure = .FALSE.
CPPrecondition(ASSOCIATED(al),cp_fatal_level,routineP,error,failure)
CPPrecondition(.NOT.ASSOCIATED(al%nvt),cp_fatal_level,routineP,error,failure)
CPPrecondition(ASSOCIATED(al),cp_fatal_level,routineP,failure)
CPPrecondition(.NOT.ASSOCIATED(al%nvt),cp_fatal_level,routineP,failure)

ALLOCATE ( al%nvt(al%loc_num_al),stat=stat)
CPPostcondition(stat==0,cp_failure_level,routineP,error,failure)
CPPostcondition(stat==0,cp_failure_level,routineP,failure)
DO i = 1, al%loc_num_al
al%nvt(i)%chi = 0.0_dp
END DO
! Initialize the gaussian stream random number
ALLOCATE (seed(3,2,al%glob_num_al),STAT=stat)
CPPostcondition(stat==0,cp_failure_level,routineP,error,failure)
CPPostcondition(stat==0,cp_failure_level,routineP,failure)

END SUBROUTINE al_thermo_create

! *****************************************************************************
!> \brief Deallocate type for AD_LANGEVIN thermostat
!> \param al ...
!> \param error variable to control error logging, stopping,...
!> see module cp_error_handling
!> \author Noam Bernstein [noamb] 02.2012
! *****************************************************************************
SUBROUTINE al_dealloc ( al, error )
SUBROUTINE al_dealloc ( al)
TYPE(al_system_type), POINTER :: al
TYPE(cp_error_type), INTENT(inout) :: error

CHARACTER(LEN=*), PARAMETER :: routineN = 'al_dealloc', &
routineP = moduleN//':'//routineN
Expand All @@ -134,25 +125,22 @@ SUBROUTINE al_dealloc ( al, error )

failure = .FALSE.
IF (ASSOCIATED(al)) THEN
CALL al_thermo_dealloc(al%nvt, error)
CALL release_map_info_type(al%map_info, error)
CALL al_thermo_dealloc(al%nvt)
CALL release_map_info_type(al%map_info)
DEALLOCATE (al, STAT=stat)
CPPrecondition(stat==0,cp_fatal_level,routineP,error,failure)
CPPrecondition(stat==0,cp_fatal_level,routineP,failure)
ENDIF

END SUBROUTINE al_dealloc

! *****************************************************************************
!> \brief Deallocate NVT type for AD_LANGEVIN thermostat
!> \param nvt ...
!> \param error variable to control error logging, stopping,...
!> see module cp_error_handling
!> \author Noam Bernstein [noamb] 02.2012
! *****************************************************************************
SUBROUTINE al_thermo_dealloc ( nvt, error )
SUBROUTINE al_thermo_dealloc ( nvt)
TYPE(al_thermo_type), DIMENSION(:), &
POINTER :: nvt
TYPE(cp_error_type), INTENT(inout) :: error

CHARACTER(LEN=*), PARAMETER :: routineN = 'al_thermo_dealloc', &
routineP = moduleN//':'//routineN
Expand All @@ -163,7 +151,7 @@ SUBROUTINE al_thermo_dealloc ( nvt, error )
failure = .FALSE.
IF (ASSOCIATED(nvt)) THEN
DEALLOCATE (nvt, STAT=stat)
CPPrecondition(stat==0,cp_fatal_level,routineP,error,failure)
CPPrecondition(stat==0,cp_fatal_level,routineP,failure)
ENDIF
END SUBROUTINE al_thermo_dealloc

Expand Down
Loading

0 comments on commit fbfeb0d

Please sign in to comment.