LCOV - code coverage report
Current view: top level - src - optimize_basis_types.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:2fce0f8) Lines: 53 54 98.1 %
Date: 2024-12-21 06:28:57 Functions: 2 17 11.8 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : MODULE optimize_basis_types
       8             : 
       9             :    USE kinds,                           ONLY: default_path_length,&
      10             :                                               default_string_length,&
      11             :                                               dp
      12             :    USE powell,                          ONLY: opt_state_type
      13             : #include "./base/base_uses.f90"
      14             : 
      15             :    IMPLICIT NONE
      16             :    PRIVATE
      17             : 
      18             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'optimize_basis_types'
      19             : 
      20             :    PUBLIC :: basis_optimization_type, subset_type, flex_basis_type, &
      21             :              derived_basis_info, deallocate_basis_optimization_type
      22             : 
      23             :    ! constraint information for a single constraing. boundary is translateed into a fermi function
      24             :    ! like setting as for variational limited case
      25             :    TYPE exp_constraint_type
      26             :       INTEGER                                            :: const_type = -1
      27             :       REAL(KIND=dp)                                      :: llim = -1.0_dp, ulim = -1.0_dp
      28             :       REAL(KIND=dp)                                      :: init = -1.0_dp, var_fac = -1.0_dp
      29             :    END TYPE
      30             : 
      31             :    ! Subset of a basis+ additional information on what to optimize.
      32             :    ! *_x_ind maps to the index in the optimization vector
      33             :    !  opt_* logical whether quantity ahould be optimized
      34             :    !  *_const information for exponents used to constrain them
      35             :    TYPE subset_type
      36             :       INTEGER                                            :: lmin = -1, lmax = -1, nexp = -1
      37             :       INTEGER                                            :: n = -1, ncon_tot = -1, nl = -1
      38             :       INTEGER, DIMENSION(:), ALLOCATABLE                 :: l
      39             :       REAL(KIND=dp), DIMENSION(:, :), ALLOCATABLE        :: coeff
      40             :       LOGICAL, DIMENSION(:, :), ALLOCATABLE              :: opt_coeff
      41             :       INTEGER, DIMENSION(:, :), ALLOCATABLE              :: coeff_x_ind
      42             :       REAL(KIND=dp), DIMENSION(:), ALLOCATABLE           :: exps
      43             :       LOGICAL, DIMENSION(:), ALLOCATABLE                 :: opt_exps
      44             :       INTEGER, DIMENSION(:), ALLOCATABLE                 :: exp_x_ind
      45             :       LOGICAL, DIMENSION(:), ALLOCATABLE                 :: exp_has_const
      46             :       TYPE(exp_constraint_type), DIMENSION(:), &
      47             :          ALLOCATABLE                                      :: exp_const
      48             :    END TYPE
      49             : 
      50             :    ! Top level information for basis sets+ vector subset with the real information
      51             :    TYPE flex_basis_type
      52             :       CHARACTER(LEN=default_string_length)               :: basis_name = ""
      53             :       INTEGER                                            :: nopt = -1
      54             :       INTEGER                                            :: nsets = -1
      55             :       TYPE(subset_type), DIMENSION(:), ALLOCATABLE       :: subset
      56             :    END TYPE
      57             : 
      58             :    ! information for optimization: whether coeff has to be optimized or not
      59             :    TYPE use_contr_type
      60             :       LOGICAL, DIMENSION(:), ALLOCATABLE                 :: in_use
      61             :    END TYPE
      62             : 
      63             :    ! information about how to generate the derived basis sets
      64             :    TYPE derived_basis_info
      65             :       CHARACTER(LEN=default_string_length)               :: basis_name = ""
      66             :       INTEGER                                            :: reference_set = -1
      67             :       INTEGER, DIMENSION(:, :), ALLOCATABLE              :: remove_contr
      68             :       INTEGER                                            :: nsets = -1, ncontr = -1
      69             :       INTEGER, DIMENSION(:), ALLOCATABLE                 :: remove_set
      70             :       LOGICAL, DIMENSION(:), ALLOCATABLE                 :: in_use_set
      71             :       TYPE(use_contr_type), DIMENSION(:), ALLOCATABLE    :: use_contr
      72             :    END TYPE
      73             : 
      74             :    ! some usual stuff for basis information and an info type containing the
      75             :    ! the translated input on how to genrate the derived basis sets
      76             :    ! a flexible basis type for every derived basis
      77             :    ! ATTENTION: both vectors go from 0:nbasis_deriv. entry 0 is the one specified
      78             :    !            in the template basis file
      79             :    TYPE kind_basis_type
      80             :       CHARACTER(LEN=default_string_length)               :: basis_name = ""
      81             :       CHARACTER(LEN=default_string_length)               :: element = ""
      82             :       INTEGER                                            :: nbasis_deriv = -1
      83             :       TYPE(derived_basis_info), DIMENSION(:), &
      84             :          ALLOCATABLE                                      :: deriv_info
      85             :       TYPE(flex_basis_type), DIMENSION(:), ALLOCATABLE   :: flex_basis
      86             :    END TYPE
      87             : 
      88             :    ! vector of length nparallel_groups containing the id's of the calculations in the group
      89             :    TYPE comp_group_type
      90             :       INTEGER, DIMENSION(:), ALLOCATABLE                 :: member_list
      91             :    END TYPE
      92             : 
      93             : ! **************************************************************************************************
      94             : !> \brief type containing all information needed for basis matching
      95             : !> \author Florian Schiffmann
      96             : ! **************************************************************************************************
      97             :    TYPE basis_optimization_type
      98             :       TYPE(comp_group_type), DIMENSION(:), ALLOCATABLE  :: comp_group
      99             :       INTEGER :: ntraining_sets = -1
     100             :       INTEGER :: ncombinations = -1
     101             :       LOGICAL :: use_condition_number = .FALSE.
     102             :       INTEGER, DIMENSION(:), POINTER   :: group_partition => NULL()
     103             :       INTEGER :: n_groups_created = -1
     104             :       INTEGER, DIMENSION(:), ALLOCATABLE :: sub_sources
     105             :       INTEGER, DIMENSION(:, :), ALLOCATABLE :: combination
     106             :       REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: fval_weight
     107             :       REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: condition_weight
     108             :       INTEGER :: nkind = -1
     109             :       INTEGER :: write_frequency = -1
     110             :       INTEGER :: nbasis_deriv_types = -1
     111             :       REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: x_opt
     112             :       TYPE(opt_state_type)  :: powell_param = opt_state_type()
     113             :       CHARACTER(LEN=default_path_length), DIMENSION(:), ALLOCATABLE :: training_input
     114             :       CHARACTER(LEN=default_path_length), DIMENSION(:), ALLOCATABLE :: training_dir
     115             :       CHARACTER(LEN=default_path_length) :: work_basis_file = ""
     116             :       CHARACTER(LEN=default_path_length) :: output_basis_file = ""
     117             :       CHARACTER(LEN=default_path_length) :: template_basis_file = ""
     118             :       TYPE(kind_basis_type), DIMENSION(:), ALLOCATABLE :: kind_basis
     119             :       INTEGER :: opt_id = -1
     120             :    END TYPE
     121             : 
     122             : CONTAINS
     123             : 
     124             : ! **************************************************************************************************
     125             : !> \brief Deallocate everything which was allocated before.
     126             : !>        Note not all arrays are used depending on the type of basis
     127             : !>        i.e derived or reference basis set
     128             : !> \param opt_bas ...
     129             : !> \author Florian Schiffmann
     130             : ! **************************************************************************************************
     131             : 
     132           4 :    SUBROUTINE deallocate_basis_optimization_type(opt_bas)
     133             :       TYPE(basis_optimization_type)                      :: opt_bas
     134             : 
     135             :       INTEGER                                            :: igroup, ikind
     136             : 
     137           4 :       IF (ASSOCIATED(opt_bas%group_partition)) DEALLOCATE (opt_bas%group_partition)
     138           4 :       IF (ALLOCATED(opt_bas%sub_sources)) DEALLOCATE (opt_bas%sub_sources)
     139           4 :       IF (ALLOCATED(opt_bas%combination)) DEALLOCATE (opt_bas%combination)
     140           4 :       IF (ALLOCATED(opt_bas%x_opt)) DEALLOCATE (opt_bas%x_opt)
     141           4 :       IF (ALLOCATED(opt_bas%training_input)) DEALLOCATE (opt_bas%training_input)
     142           4 :       IF (ALLOCATED(opt_bas%training_dir)) DEALLOCATE (opt_bas%training_dir)
     143           4 :       IF (ALLOCATED(opt_bas%fval_weight)) DEALLOCATE (opt_bas%fval_weight)
     144           4 :       IF (ALLOCATED(opt_bas%condition_weight)) DEALLOCATE (opt_bas%condition_weight)
     145             : 
     146           4 :       IF (ALLOCATED(opt_bas%comp_group)) THEN
     147          12 :          DO igroup = 1, SIZE(opt_bas%comp_group)
     148          12 :             IF (ALLOCATED(opt_bas%comp_group(igroup)%member_list)) DEALLOCATE (opt_bas%comp_group(igroup)%member_list)
     149             :          END DO
     150          12 :          DEALLOCATE (opt_bas%comp_group)
     151             :       END IF
     152             : 
     153           4 :       IF (ALLOCATED(opt_bas%kind_basis)) THEN
     154          12 :          DO ikind = 1, SIZE(opt_bas%kind_basis)
     155          12 :             CALL deallocate_kind_basis(opt_bas%kind_basis(ikind))
     156             :          END DO
     157          12 :          DEALLOCATE (opt_bas%kind_basis)
     158             :       END IF
     159             : 
     160           4 :    END SUBROUTINE deallocate_basis_optimization_type
     161             : 
     162             : ! **************************************************************************************************
     163             : !> \brief Some more deallocation of the subtypes of optimize_absis type
     164             : !> \param kind ...
     165             : !> \author Florian Schiffmann
     166             : ! **************************************************************************************************
     167             : 
     168           8 :    SUBROUTINE deallocate_kind_basis(kind)
     169             :       TYPE(kind_basis_type)                              :: kind
     170             : 
     171             :       INTEGER                                            :: ibasis, icont, iinfo, iset
     172             : 
     173           8 :       IF (ALLOCATED(kind%deriv_info)) THEN
     174          32 :          DO iinfo = 0, SIZE(kind%deriv_info) - 1
     175          24 :             IF (ALLOCATED(kind%deriv_info(iinfo)%remove_contr)) DEALLOCATE (kind%deriv_info(iinfo)%remove_contr)
     176          24 :             IF (ALLOCATED(kind%deriv_info(iinfo)%remove_set)) DEALLOCATE (kind%deriv_info(iinfo)%remove_set)
     177          24 :             IF (ALLOCATED(kind%deriv_info(iinfo)%in_use_set)) DEALLOCATE (kind%deriv_info(iinfo)%in_use_set)
     178          32 :             IF (ALLOCATED(kind%deriv_info(iinfo)%use_contr)) THEN
     179          48 :                DO icont = 1, SIZE(kind%deriv_info(iinfo)%use_contr)
     180          24 :                   IF (ALLOCATED(kind%deriv_info(iinfo)%use_contr(icont)%in_use)) &
     181          48 :                      DEALLOCATE (kind%deriv_info(iinfo)%use_contr(icont)%in_use)
     182             :                END DO
     183          48 :                DEALLOCATE (kind%deriv_info(iinfo)%use_contr)
     184             :             END IF
     185             :          END DO
     186          32 :          DEALLOCATE (kind%deriv_info)
     187             :       END IF
     188             : 
     189           8 :       IF (ALLOCATED(kind%flex_basis)) THEN
     190          32 :          DO ibasis = 0, SIZE(kind%flex_basis) - 1
     191          32 :             IF (ALLOCATED(kind%flex_basis(ibasis)%subset)) THEN
     192          48 :                DO iset = 1, SIZE(kind%flex_basis(ibasis)%subset)
     193          24 :                   IF (ALLOCATED(kind%flex_basis(ibasis)%subset(iset)%l)) &
     194          24 :                      DEALLOCATE (kind%flex_basis(ibasis)%subset(iset)%l)
     195          24 :                   IF (ALLOCATED(kind%flex_basis(ibasis)%subset(iset)%coeff)) &
     196          24 :                      DEALLOCATE (kind%flex_basis(ibasis)%subset(iset)%coeff)
     197          24 :                   IF (ALLOCATED(kind%flex_basis(ibasis)%subset(iset)%opt_coeff)) &
     198           8 :                      DEALLOCATE (kind%flex_basis(ibasis)%subset(iset)%opt_coeff)
     199          24 :                   IF (ALLOCATED(kind%flex_basis(ibasis)%subset(iset)%coeff_x_ind)) &
     200           8 :                      DEALLOCATE (kind%flex_basis(ibasis)%subset(iset)%coeff_x_ind)
     201          24 :                   IF (ALLOCATED(kind%flex_basis(ibasis)%subset(iset)%exps)) &
     202          24 :                      DEALLOCATE (kind%flex_basis(ibasis)%subset(iset)%exps)
     203          24 :                   IF (ALLOCATED(kind%flex_basis(ibasis)%subset(iset)%opt_exps)) &
     204           8 :                      DEALLOCATE (kind%flex_basis(ibasis)%subset(iset)%opt_exps)
     205          24 :                   IF (ALLOCATED(kind%flex_basis(ibasis)%subset(iset)%exp_x_ind)) &
     206           8 :                      DEALLOCATE (kind%flex_basis(ibasis)%subset(iset)%exp_x_ind)
     207          24 :                   IF (ALLOCATED(kind%flex_basis(ibasis)%subset(iset)%exp_const)) &
     208          32 :                      DEALLOCATE (kind%flex_basis(ibasis)%subset(iset)%exp_const)
     209             :                END DO
     210          48 :                DEALLOCATE (kind%flex_basis(ibasis)%subset)
     211             :             END IF
     212             :          END DO
     213          32 :          DEALLOCATE (kind%flex_basis)
     214             :       END IF
     215             : 
     216           8 :    END SUBROUTINE deallocate_kind_basis
     217             : 
     218           0 : END MODULE optimize_basis_types

Generated by: LCOV version 1.15