LCOV - code coverage report
Current view: top level - src - almo_scf_diis_types.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 88.8 % 188 167
Test Date: 2025-07-25 12:55:17 Functions: 75.0 % 8 6

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief A DIIS implementation for the ALMO-based SCF methods
      10              : !> \par History
      11              : !>       2011.12 created [Rustam Z Khaliullin]
      12              : !> \author Rustam Z Khaliullin
      13              : ! **************************************************************************************************
      14              : MODULE almo_scf_diis_types
      15              :    USE cp_dbcsr_api,                    ONLY: dbcsr_add,&
      16              :                                               dbcsr_copy,&
      17              :                                               dbcsr_create,&
      18              :                                               dbcsr_release,&
      19              :                                               dbcsr_set,&
      20              :                                               dbcsr_type
      21              :    USE cp_dbcsr_contrib,                ONLY: dbcsr_dot
      22              :    USE cp_log_handling,                 ONLY: cp_get_default_logger,&
      23              :                                               cp_logger_get_default_unit_nr,&
      24              :                                               cp_logger_type
      25              :    USE domain_submatrix_methods,        ONLY: add_submatrices,&
      26              :                                               copy_submatrices,&
      27              :                                               init_submatrices,&
      28              :                                               release_submatrices,&
      29              :                                               set_submatrices
      30              :    USE domain_submatrix_types,          ONLY: domain_submatrix_type
      31              :    USE kinds,                           ONLY: dp
      32              : #include "./base/base_uses.f90"
      33              : 
      34              :    IMPLICIT NONE
      35              : 
      36              :    PRIVATE
      37              : 
      38              :    INTEGER, PARAMETER :: diis_error_orthogonal = 1
      39              : 
      40              :    INTEGER, PARAMETER :: diis_env_dbcsr = 1
      41              :    INTEGER, PARAMETER :: diis_env_domain = 2
      42              : 
      43              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'almo_scf_diis_types'
      44              : 
      45              :    PUBLIC :: almo_scf_diis_type, &
      46              :              almo_scf_diis_init, almo_scf_diis_release, almo_scf_diis_push, &
      47              :              almo_scf_diis_extrapolate
      48              : 
      49              :    INTERFACE almo_scf_diis_init
      50              :       MODULE PROCEDURE almo_scf_diis_init_dbcsr
      51              :       MODULE PROCEDURE almo_scf_diis_init_domain
      52              :    END INTERFACE
      53              : 
      54              :    TYPE almo_scf_diis_type
      55              : 
      56              :       INTEGER :: diis_env_type = 0
      57              : 
      58              :       INTEGER :: buffer_length = 0
      59              :       INTEGER :: max_buffer_length = 0
      60              :       !INTEGER, DIMENSION(:), ALLOCATABLE :: history_index
      61              : 
      62              :       TYPE(dbcsr_type), DIMENSION(:), ALLOCATABLE :: m_var
      63              :       TYPE(dbcsr_type), DIMENSION(:), ALLOCATABLE :: m_err
      64              : 
      65              :       ! first dimension is history index, second - domain index
      66              :       TYPE(domain_submatrix_type), DIMENSION(:, :), ALLOCATABLE :: d_var
      67              :       TYPE(domain_submatrix_type), DIMENSION(:, :), ALLOCATABLE :: d_err
      68              : 
      69              :       ! distributed matrix of error overlaps
      70              :       TYPE(domain_submatrix_type), DIMENSION(:), ALLOCATABLE     :: m_b
      71              : 
      72              :       ! insertion point
      73              :       INTEGER :: in_point = 0
      74              : 
      75              :       ! in order to calculate the overlap between error vectors
      76              :       ! it is desirable to know tensorial properties of the error
      77              :       ! vector, e.g. convariant, contravariant, orthogonal
      78              :       INTEGER :: error_type = 0
      79              : 
      80              :    END TYPE almo_scf_diis_type
      81              : 
      82              : CONTAINS
      83              : 
      84              : ! **************************************************************************************************
      85              : !> \brief initializes the diis structure
      86              : !> \param diis_env ...
      87              : !> \param sample_err ...
      88              : !> \param sample_var ...
      89              : !> \param error_type ...
      90              : !> \param max_length ...
      91              : !> \par History
      92              : !>       2011.12 created [Rustam Z Khaliullin]
      93              : !> \author Rustam Z Khaliullin
      94              : ! **************************************************************************************************
      95           76 :    SUBROUTINE almo_scf_diis_init_dbcsr(diis_env, sample_err, sample_var, error_type, &
      96              :                                        max_length)
      97              : 
      98              :       TYPE(almo_scf_diis_type), INTENT(INOUT)            :: diis_env
      99              :       TYPE(dbcsr_type), INTENT(IN)                       :: sample_err, sample_var
     100              :       INTEGER, INTENT(IN)                                :: error_type, max_length
     101              : 
     102              :       CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_init_dbcsr'
     103              : 
     104              :       INTEGER                                            :: handle, idomain, im, ndomains
     105              : 
     106           76 :       CALL timeset(routineN, handle)
     107              : 
     108           76 :       IF (max_length .LE. 0) THEN
     109            0 :          CPABORT("DIIS: max_length is less than zero")
     110              :       END IF
     111              : 
     112           76 :       diis_env%diis_env_type = diis_env_dbcsr
     113              : 
     114           76 :       diis_env%max_buffer_length = max_length
     115           76 :       diis_env%buffer_length = 0
     116           76 :       diis_env%error_type = error_type
     117           76 :       diis_env%in_point = 1
     118              : 
     119          600 :       ALLOCATE (diis_env%m_err(diis_env%max_buffer_length))
     120          600 :       ALLOCATE (diis_env%m_var(diis_env%max_buffer_length))
     121              : 
     122              :       ! create matrices
     123          448 :       DO im = 1, diis_env%max_buffer_length
     124              :          CALL dbcsr_create(diis_env%m_err(im), &
     125          372 :                            template=sample_err)
     126              :          CALL dbcsr_create(diis_env%m_var(im), &
     127          448 :                            template=sample_var)
     128              :       END DO
     129              : 
     130              :       ! current B matrices are only 1-by-1, they will be expanded on-the-fly
     131              :       ! only one matrix is used with dbcsr version of DIIS
     132           76 :       ndomains = 1
     133          152 :       ALLOCATE (diis_env%m_b(ndomains))
     134           76 :       CALL init_submatrices(diis_env%m_b)
     135              :       ! hack into d_b structure to gain full control
     136          152 :       diis_env%m_b(:)%domain = 100 ! arbitrary positive number
     137          152 :       DO idomain = 1, ndomains
     138          152 :          IF (diis_env%m_b(idomain)%domain .GT. 0) THEN
     139           76 :             ALLOCATE (diis_env%m_b(idomain)%mdata(1, 1))
     140          228 :             diis_env%m_b(idomain)%mdata(:, :) = 0.0_dp
     141              :          END IF
     142              :       END DO
     143              : 
     144           76 :       CALL timestop(handle)
     145              : 
     146           76 :    END SUBROUTINE almo_scf_diis_init_dbcsr
     147              : 
     148              : ! **************************************************************************************************
     149              : !> \brief initializes the diis structure
     150              : !> \param diis_env ...
     151              : !> \param sample_err ...
     152              : !> \param error_type ...
     153              : !> \param max_length ...
     154              : !> \par History
     155              : !>       2011.12 created [Rustam Z Khaliullin]
     156              : !> \author Rustam Z Khaliullin
     157              : ! **************************************************************************************************
     158            2 :    SUBROUTINE almo_scf_diis_init_domain(diis_env, sample_err, error_type, &
     159              :                                         max_length)
     160              : 
     161              :       TYPE(almo_scf_diis_type), INTENT(INOUT)            :: diis_env
     162              :       TYPE(domain_submatrix_type), DIMENSION(:), &
     163              :          INTENT(IN)                                      :: sample_err
     164              :       INTEGER, INTENT(IN)                                :: error_type, max_length
     165              : 
     166              :       CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_init_domain'
     167              : 
     168              :       INTEGER                                            :: handle, idomain, ndomains
     169              : 
     170            2 :       CALL timeset(routineN, handle)
     171              : 
     172            2 :       IF (max_length .LE. 0) THEN
     173            0 :          CPABORT("DIIS: max_length is less than zero")
     174              :       END IF
     175              : 
     176            2 :       diis_env%diis_env_type = diis_env_domain
     177              : 
     178            2 :       diis_env%max_buffer_length = max_length
     179            2 :       diis_env%buffer_length = 0
     180            2 :       diis_env%error_type = error_type
     181            2 :       diis_env%in_point = 1
     182              : 
     183            2 :       ndomains = SIZE(sample_err)
     184              : 
     185           38 :       ALLOCATE (diis_env%d_err(diis_env%max_buffer_length, ndomains))
     186           38 :       ALLOCATE (diis_env%d_var(diis_env%max_buffer_length, ndomains))
     187              : 
     188              :       ! create matrices
     189            2 :       CALL init_submatrices(diis_env%d_var)
     190            2 :       CALL init_submatrices(diis_env%d_err)
     191              : 
     192              :       ! current B matrices are only 1-by-1, they will be expanded on-the-fly
     193           16 :       ALLOCATE (diis_env%m_b(ndomains))
     194            2 :       CALL init_submatrices(diis_env%m_b)
     195              :       ! hack into d_b structure to gain full control
     196              :       ! distribute matrices as the err/var matrices
     197           12 :       diis_env%m_b(:)%domain = sample_err(:)%domain
     198           12 :       DO idomain = 1, ndomains
     199           12 :          IF (diis_env%m_b(idomain)%domain .GT. 0) THEN
     200            5 :             ALLOCATE (diis_env%m_b(idomain)%mdata(1, 1))
     201           15 :             diis_env%m_b(idomain)%mdata(:, :) = 0.0_dp
     202              :          END IF
     203              :       END DO
     204              : 
     205            2 :       CALL timestop(handle)
     206              : 
     207            2 :    END SUBROUTINE almo_scf_diis_init_domain
     208              : 
     209              : ! **************************************************************************************************
     210              : !> \brief adds a variable-error pair to the diis structure
     211              : !> \param diis_env ...
     212              : !> \param var ...
     213              : !> \param err ...
     214              : !> \param d_var ...
     215              : !> \param d_err ...
     216              : !> \par History
     217              : !>       2011.12 created [Rustam Z Khaliullin]
     218              : !> \author Rustam Z Khaliullin
     219              : ! **************************************************************************************************
     220          426 :    SUBROUTINE almo_scf_diis_push(diis_env, var, err, d_var, d_err)
     221              :       TYPE(almo_scf_diis_type), INTENT(INOUT)            :: diis_env
     222              :       TYPE(dbcsr_type), INTENT(IN), OPTIONAL             :: var, err
     223              :       TYPE(domain_submatrix_type), DIMENSION(:), &
     224              :          INTENT(IN), OPTIONAL                            :: d_var, d_err
     225              : 
     226              :       CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_push'
     227              : 
     228              :       INTEGER                                            :: handle, idomain, in_point, irow, &
     229              :                                                             ndomains, old_buffer_length
     230              :       REAL(KIND=dp)                                      :: trace0
     231          426 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: m_b_tmp
     232              : 
     233          426 :       CALL timeset(routineN, handle)
     234              : 
     235          426 :       IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
     236          424 :          IF (.NOT. (PRESENT(var) .AND. PRESENT(err))) THEN
     237            0 :             CPABORT("provide DBCSR matrices")
     238              :          END IF
     239            2 :       ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
     240            2 :          IF (.NOT. (PRESENT(d_var) .AND. PRESENT(d_err))) THEN
     241            0 :             CPABORT("provide domain submatrices")
     242              :          END IF
     243              :       ELSE
     244            0 :          CPABORT("illegal DIIS ENV type")
     245              :       END IF
     246              : 
     247          426 :       in_point = diis_env%in_point
     248              : 
     249              :       ! store a var-error pair
     250          426 :       IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
     251          424 :          CALL dbcsr_copy(diis_env%m_var(in_point), var)
     252          424 :          CALL dbcsr_copy(diis_env%m_err(in_point), err)
     253            2 :       ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
     254            2 :          CALL copy_submatrices(d_var, diis_env%d_var(in_point, :), copy_data=.TRUE.)
     255            2 :          CALL copy_submatrices(d_err, diis_env%d_err(in_point, :), copy_data=.TRUE.)
     256              :       END IF
     257              : 
     258              :       ! update the buffer length
     259          426 :       old_buffer_length = diis_env%buffer_length
     260          426 :       diis_env%buffer_length = diis_env%buffer_length + 1
     261          426 :       IF (diis_env%buffer_length .GT. diis_env%max_buffer_length) &
     262           96 :          diis_env%buffer_length = diis_env%max_buffer_length
     263              : 
     264              :       !!!! resize B matrix
     265              :       !!!IF (old_buffer_length.lt.diis_env%buffer_length) THEN
     266              :       !!!   ALLOCATE(m_b_tmp(diis_env%buffer_length+1,diis_env%buffer_length+1))
     267              :       !!!   m_b_tmp(1:diis_env%buffer_length,1:diis_env%buffer_length)=&
     268              :       !!!      diis_env%m_b(:,:)
     269              :       !!!   DEALLOCATE(diis_env%m_b)
     270              :       !!!   ALLOCATE(diis_env%m_b(diis_env%buffer_length+1,&
     271              :       !!!      diis_env%buffer_length+1))
     272              :       !!!   diis_env%m_b(:,:)=m_b_tmp(:,:)
     273              :       !!!   DEALLOCATE(m_b_tmp)
     274              :       !!!ENDIF
     275              :       !!!! update B matrix elements
     276              :       !!!diis_env%m_b(1,in_point+1)=-1.0_dp
     277              :       !!!diis_env%m_b(in_point+1,1)=-1.0_dp
     278              :       !!!DO irow=1,diis_env%buffer_length
     279              :       !!!   trace0=almo_scf_diis_error_overlap(diis_env,&
     280              :       !!!      A=diis_env%m_err(irow),B=diis_env%m_err(in_point))
     281              :       !!!
     282              :       !!!   diis_env%m_b(irow+1,in_point+1)=trace0
     283              :       !!!   diis_env%m_b(in_point+1,irow+1)=trace0
     284              :       !!!ENDDO
     285              : 
     286              :       ! resize B matrix and update its elements
     287          426 :       ndomains = SIZE(diis_env%m_b)
     288          426 :       IF (old_buffer_length .LT. diis_env%buffer_length) THEN
     289         1320 :          ALLOCATE (m_b_tmp(diis_env%buffer_length + 1, diis_env%buffer_length + 1))
     290          668 :          DO idomain = 1, ndomains
     291          668 :             IF (diis_env%m_b(idomain)%domain .GT. 0) THEN
     292         6947 :                m_b_tmp(:, :) = 0.0_dp
     293              :                m_b_tmp(1:diis_env%buffer_length, 1:diis_env%buffer_length) = &
     294         4447 :                   diis_env%m_b(idomain)%mdata(:, :)
     295          333 :                DEALLOCATE (diis_env%m_b(idomain)%mdata)
     296            0 :                ALLOCATE (diis_env%m_b(idomain)%mdata(diis_env%buffer_length + 1, &
     297         1332 :                                                      diis_env%buffer_length + 1))
     298         6947 :                diis_env%m_b(idomain)%mdata(:, :) = m_b_tmp(:, :)
     299              :             END IF
     300              :          END DO
     301          330 :          DEALLOCATE (m_b_tmp)
     302              :       END IF
     303          860 :       DO idomain = 1, ndomains
     304          860 :          IF (diis_env%m_b(idomain)%domain .GT. 0) THEN
     305          429 :             diis_env%m_b(idomain)%mdata(1, in_point + 1) = -1.0_dp
     306          429 :             diis_env%m_b(idomain)%mdata(in_point + 1, 1) = -1.0_dp
     307         1796 :             DO irow = 1, diis_env%buffer_length
     308         1367 :                IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
     309              :                   trace0 = almo_scf_diis_error_overlap(diis_env, &
     310         1362 :                                                        A=diis_env%m_err(irow), B=diis_env%m_err(in_point))
     311            5 :                ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
     312              :                   trace0 = almo_scf_diis_error_overlap(diis_env, &
     313              :                                                        d_A=diis_env%d_err(irow, idomain), &
     314            5 :                                                        d_B=diis_env%d_err(in_point, idomain))
     315              :                END IF
     316         1367 :                diis_env%m_b(idomain)%mdata(irow + 1, in_point + 1) = trace0
     317         1796 :                diis_env%m_b(idomain)%mdata(in_point + 1, irow + 1) = trace0
     318              :             END DO ! loop over prev errors
     319              :          END IF
     320              :       END DO ! loop over domains
     321              : 
     322              :       ! update the insertion point for the next "PUSH"
     323          426 :       diis_env%in_point = diis_env%in_point + 1
     324          426 :       IF (diis_env%in_point .GT. diis_env%max_buffer_length) diis_env%in_point = 1
     325              : 
     326          426 :       CALL timestop(handle)
     327              : 
     328          426 :    END SUBROUTINE almo_scf_diis_push
     329              : 
     330              : ! **************************************************************************************************
     331              : !> \brief extrapolates the variable using the saved history
     332              : !> \param diis_env ...
     333              : !> \param extr_var ...
     334              : !> \param d_extr_var ...
     335              : !> \par History
     336              : !>       2011.12 created [Rustam Z Khaliullin]
     337              : !> \author Rustam Z Khaliullin
     338              : ! **************************************************************************************************
     339          272 :    SUBROUTINE almo_scf_diis_extrapolate(diis_env, extr_var, d_extr_var)
     340              :       TYPE(almo_scf_diis_type), INTENT(INOUT)            :: diis_env
     341              :       TYPE(dbcsr_type), INTENT(INOUT), OPTIONAL          :: extr_var
     342              :       TYPE(domain_submatrix_type), DIMENSION(:), &
     343              :          INTENT(INOUT), OPTIONAL                         :: d_extr_var
     344              : 
     345              :       CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_extrapolate'
     346              : 
     347              :       INTEGER                                            :: handle, idomain, im, INFO, LWORK, &
     348              :                                                             ndomains, unit_nr
     349              :       REAL(KIND=dp)                                      :: checksum
     350          272 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: coeff, eigenvalues, tmp1, WORK
     351          272 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: m_b_copy
     352              :       TYPE(cp_logger_type), POINTER                      :: logger
     353              : 
     354          272 :       CALL timeset(routineN, handle)
     355              : 
     356              :       ! get a useful output_unit
     357          272 :       logger => cp_get_default_logger()
     358          272 :       IF (logger%para_env%is_source()) THEN
     359          136 :          unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
     360              :       ELSE
     361              :          unit_nr = -1
     362              :       END IF
     363              : 
     364          272 :       IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
     365          272 :          IF (.NOT. PRESENT(extr_var)) THEN
     366            0 :             CPABORT("provide DBCSR matrix")
     367              :          END IF
     368            0 :       ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
     369            0 :          IF (.NOT. PRESENT(d_extr_var)) THEN
     370            0 :             CPABORT("provide domain submatrices")
     371              :          END IF
     372              :       ELSE
     373            0 :          CPABORT("illegal DIIS ENV type")
     374              :       END IF
     375              : 
     376              :       ! Prepare data
     377          816 :       ALLOCATE (eigenvalues(diis_env%buffer_length + 1))
     378         1088 :       ALLOCATE (m_b_copy(diis_env%buffer_length + 1, diis_env%buffer_length + 1))
     379              : 
     380          272 :       ndomains = SIZE(diis_env%m_b)
     381              : 
     382          544 :       DO idomain = 1, ndomains
     383              : 
     384          544 :          IF (diis_env%m_b(idomain)%domain .GT. 0) THEN
     385              : 
     386         7456 :             m_b_copy(:, :) = diis_env%m_b(idomain)%mdata(:, :)
     387              : 
     388              :             ! Query the optimal workspace for dsyev
     389          272 :             LWORK = -1
     390          272 :             ALLOCATE (WORK(MAX(1, LWORK)))
     391              :             CALL dsyev('V', 'L', diis_env%buffer_length + 1, m_b_copy, &
     392          272 :                        diis_env%buffer_length + 1, eigenvalues, WORK, LWORK, INFO)
     393          272 :             LWORK = INT(WORK(1))
     394          272 :             DEALLOCATE (WORK)
     395              : 
     396              :             ! Allocate the workspace and solve the eigenproblem
     397          816 :             ALLOCATE (WORK(MAX(1, LWORK)))
     398              :             CALL dsyev('V', 'L', diis_env%buffer_length + 1, m_b_copy, &
     399          272 :                        diis_env%buffer_length + 1, eigenvalues, WORK, LWORK, INFO)
     400          272 :             IF (INFO .NE. 0) CPABORT("DSYEV failed")
     401          272 :             DEALLOCATE (WORK)
     402              : 
     403              :             ! use the eigensystem to invert (implicitly) B matrix
     404              :             ! and compute the extrapolation coefficients
     405              :             !! ALLOCATE(tmp1(diis_env%buffer_length+1,1))
     406              :             !! ALLOCATE(coeff(diis_env%buffer_length+1,1))
     407              :             !! tmp1(:,1)=-1.0_dp*m_b_copy(1,:)/eigenvalues(:)
     408              :             !! coeff=MATMUL(m_b_copy,tmp1)
     409              :             !! DEALLOCATE(tmp1)
     410          816 :             ALLOCATE (tmp1(diis_env%buffer_length + 1))
     411          544 :             ALLOCATE (coeff(diis_env%buffer_length + 1))
     412         1502 :             tmp1(:) = -1.0_dp*m_b_copy(1, :)/eigenvalues(:)
     413         8686 :             coeff(:) = MATMUL(m_b_copy, tmp1)
     414          272 :             DEALLOCATE (tmp1)
     415              : 
     416              :             !IF (unit_nr.gt.0) THEN
     417              :             !   DO im=1,diis_env%buffer_length+1
     418              :             !      WRITE(unit_nr,*) diis_env%m_b(idomain)%mdata(im,:)
     419              :             !   ENDDO
     420              :             !   WRITE (unit_nr,*) coeff(:,1)
     421              :             !ENDIF
     422              : 
     423              :             ! extrapolate the variable
     424          272 :             checksum = 0.0_dp
     425          272 :             IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
     426          272 :                CALL dbcsr_set(extr_var, 0.0_dp)
     427         1230 :                DO im = 1, diis_env%buffer_length
     428              :                   CALL dbcsr_add(extr_var, diis_env%m_var(im), &
     429          958 :                                  1.0_dp, coeff(im + 1))
     430         1230 :                   checksum = checksum + coeff(im + 1)
     431              :                END DO
     432            0 :             ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
     433              :                CALL copy_submatrices(diis_env%d_var(1, idomain), &
     434              :                                      d_extr_var(idomain), &
     435            0 :                                      copy_data=.FALSE.)
     436            0 :                CALL set_submatrices(d_extr_var(idomain), 0.0_dp)
     437            0 :                DO im = 1, diis_env%buffer_length
     438              :                   CALL add_submatrices(1.0_dp, d_extr_var(idomain), &
     439              :                                        coeff(im + 1), diis_env%d_var(im, idomain), &
     440            0 :                                        'N')
     441            0 :                   checksum = checksum + coeff(im + 1)
     442              :                END DO
     443              :             END IF
     444              :             !WRITE(*,*) checksum
     445              : 
     446          272 :             DEALLOCATE (coeff)
     447              : 
     448              :          END IF ! domain is local to this mpi node
     449              : 
     450              :       END DO ! loop over domains
     451              : 
     452          272 :       DEALLOCATE (eigenvalues)
     453          272 :       DEALLOCATE (m_b_copy)
     454              : 
     455          272 :       CALL timestop(handle)
     456              : 
     457          544 :    END SUBROUTINE almo_scf_diis_extrapolate
     458              : 
     459              : ! **************************************************************************************************
     460              : !> \brief computes elements of b-matrix
     461              : !> \param diis_env ...
     462              : !> \param A ...
     463              : !> \param B ...
     464              : !> \param d_A ...
     465              : !> \param d_B ...
     466              : !> \return ...
     467              : !> \par History
     468              : !>       2013.02 created [Rustam Z Khaliullin]
     469              : !> \author Rustam Z Khaliullin
     470              : ! **************************************************************************************************
     471         1367 :    FUNCTION almo_scf_diis_error_overlap(diis_env, A, B, d_A, d_B)
     472              : 
     473              :       TYPE(almo_scf_diis_type), INTENT(INOUT)            :: diis_env
     474              :       TYPE(dbcsr_type), INTENT(INOUT), OPTIONAL          :: A, B
     475              :       TYPE(domain_submatrix_type), INTENT(INOUT), &
     476              :          OPTIONAL                                        :: d_A, d_B
     477              :       REAL(KIND=dp)                                      :: almo_scf_diis_error_overlap
     478              : 
     479              :       CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_error_overlap'
     480              : 
     481              :       INTEGER                                            :: handle
     482              :       REAL(KIND=dp)                                      :: trace
     483              : 
     484         1367 :       CALL timeset(routineN, handle)
     485              : 
     486         1367 :       IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
     487         1362 :          IF (.NOT. (PRESENT(A) .AND. PRESENT(B))) THEN
     488            0 :             CPABORT("provide DBCSR matrices")
     489              :          END IF
     490            5 :       ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
     491            5 :          IF (.NOT. (PRESENT(d_A) .AND. PRESENT(d_B))) THEN
     492            0 :             CPABORT("provide domain submatrices")
     493              :          END IF
     494              :       ELSE
     495            0 :          CPABORT("illegal DIIS ENV type")
     496              :       END IF
     497              : 
     498         2734 :       SELECT CASE (diis_env%error_type)
     499              :       CASE (diis_error_orthogonal)
     500         1367 :          IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
     501         1362 :             CALL dbcsr_dot(A, B, trace)
     502            5 :          ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
     503            5 :             CPASSERT(SIZE(d_A%mdata, 1) .EQ. SIZE(d_B%mdata, 1))
     504            5 :             CPASSERT(SIZE(d_A%mdata, 2) .EQ. SIZE(d_B%mdata, 2))
     505            5 :             CPASSERT(d_A%domain .EQ. d_B%domain)
     506            5 :             CPASSERT(d_A%domain .GT. 0)
     507            5 :             CPASSERT(d_B%domain .GT. 0)
     508        31607 :             trace = SUM(d_A%mdata(:, :)*d_B%mdata(:, :))
     509              :          END IF
     510              :       CASE DEFAULT
     511         1367 :          CPABORT("Vector type is unknown")
     512              :       END SELECT
     513              : 
     514         1367 :       almo_scf_diis_error_overlap = trace
     515              : 
     516         1367 :       CALL timestop(handle)
     517              : 
     518         1367 :    END FUNCTION almo_scf_diis_error_overlap
     519              : 
     520              : ! **************************************************************************************************
     521              : !> \brief destroys the diis structure
     522              : !> \param diis_env ...
     523              : !> \par History
     524              : !>       2011.12 created [Rustam Z Khaliullin]
     525              : !> \author Rustam Z Khaliullin
     526              : ! **************************************************************************************************
     527           78 :    SUBROUTINE almo_scf_diis_release(diis_env)
     528              :       TYPE(almo_scf_diis_type), INTENT(INOUT)            :: diis_env
     529              : 
     530              :       CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_diis_release'
     531              : 
     532              :       INTEGER                                            :: handle, im
     533              : 
     534           78 :       CALL timeset(routineN, handle)
     535              : 
     536              :       ! release matrices
     537          454 :       DO im = 1, diis_env%max_buffer_length
     538          454 :          IF (diis_env%diis_env_type .EQ. diis_env_dbcsr) THEN
     539          372 :             CALL dbcsr_release(diis_env%m_err(im))
     540          372 :             CALL dbcsr_release(diis_env%m_var(im))
     541            4 :          ELSE IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
     542            4 :             CALL release_submatrices(diis_env%d_var(im, :))
     543            4 :             CALL release_submatrices(diis_env%d_err(im, :))
     544              :          END IF
     545              :       END DO
     546              : 
     547           78 :       IF (diis_env%diis_env_type .EQ. diis_env_domain) THEN
     548            2 :          CALL release_submatrices(diis_env%m_b(:))
     549              :       END IF
     550              : 
     551          164 :       IF (ALLOCATED(diis_env%m_b)) DEALLOCATE (diis_env%m_b)
     552           78 :       IF (ALLOCATED(diis_env%m_err)) DEALLOCATE (diis_env%m_err)
     553           78 :       IF (ALLOCATED(diis_env%m_var)) DEALLOCATE (diis_env%m_var)
     554           98 :       IF (ALLOCATED(diis_env%d_err)) DEALLOCATE (diis_env%d_err)
     555           98 :       IF (ALLOCATED(diis_env%d_var)) DEALLOCATE (diis_env%d_var)
     556              : 
     557           78 :       CALL timestop(handle)
     558              : 
     559           78 :    END SUBROUTINE almo_scf_diis_release
     560              : 
     561            0 : END MODULE almo_scf_diis_types
     562              : 
        

Generated by: LCOV version 2.0-1