LCOV - code coverage report
Current view: top level - src/pw_env - cp_spline_utils.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:d0bd076) Lines: 58 60 96.7 %
Date: 2021-09-15 13:52:28 Functions: 2 2 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2021 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief utils to manipulate splines on the regular grid of a pw
      10             : !> \par History
      11             : !>      01.2014 move routines related to input_section_types to separate file.
      12             : !> \author Ole Schuett
      13             : ! **************************************************************************************************
      14             : MODULE cp_spline_utils
      15             :    USE input_section_types,             ONLY: section_vals_type,&
      16             :                                               section_vals_val_get
      17             :    USE kinds,                           ONLY: dp
      18             :    USE pw_methods,                      ONLY: pw_axpy,&
      19             :                                               pw_zero
      20             :    USE pw_pool_types,                   ONLY: pw_pool_create_pw,&
      21             :                                               pw_pool_give_back_pw,&
      22             :                                               pw_pool_type
      23             :    USE pw_spline_utils,                 ONLY: &
      24             :         add_coarse2fine, add_fine2coarse, find_coeffs, pw_spline_do_precond, &
      25             :         pw_spline_precond_create, pw_spline_precond_release, pw_spline_precond_set_kind, &
      26             :         pw_spline_precond_type, spl3_1d_transf_border1, spl3_1d_transf_coeffs, spl3_nopbc, &
      27             :         spl3_nopbct, spl3_pbc
      28             :    USE pw_types,                        ONLY: REALDATA3D,&
      29             :                                               REALSPACE,&
      30             :                                               pw_type
      31             : #include "../base/base_uses.f90"
      32             : 
      33             :    IMPLICIT NONE
      34             :    PRIVATE
      35             : 
      36             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_spline_utils'
      37             : 
      38             :    PUBLIC ::  pw_prolongate_s3, pw_restrict_s3
      39             : 
      40             :    ! input constants
      41             :    INTEGER, PARAMETER, PUBLIC               :: pw_interp = 1, &
      42             :                                                spline3_nopbc_interp = 2, &
      43             :                                                spline3_pbc_interp = 3
      44             : 
      45             : CONTAINS
      46             : 
      47             : ! **************************************************************************************************
      48             : !> \brief restricts the function from a fine grid to a coarse one
      49             : !> \param pw_fine_in the fine grid
      50             : !> \param pw_coarse_out the coarse grid
      51             : !> \param coarse_pool ...
      52             : !> \param param_section ...
      53             : !> \author fawzi
      54             : !> \note
      55             : !>      extremely slow (but correct) version
      56             : ! **************************************************************************************************
      57        8352 :    SUBROUTINE pw_restrict_s3(pw_fine_in, pw_coarse_out, coarse_pool, param_section)
      58             :       TYPE(pw_type), POINTER                             :: pw_fine_in, pw_coarse_out
      59             :       TYPE(pw_pool_type), POINTER                        :: coarse_pool
      60             :       TYPE(section_vals_type), POINTER                   :: param_section
      61             : 
      62             :       CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_restrict_s3'
      63             : 
      64             :       INTEGER                                            :: aint_precond, handle, interp_kind, &
      65             :                                                             max_iter, precond_kind
      66             :       INTEGER, DIMENSION(2, 3)                           :: bo
      67             :       INTEGER, SAVE                                      :: ifile = 0
      68             :       LOGICAL                                            :: pbc, safe_computation, success
      69             :       REAL(kind=dp)                                      :: eps_r, eps_x
      70             :       TYPE(pw_spline_precond_type), POINTER              :: precond
      71             :       TYPE(pw_type), POINTER                             :: coeffs, values
      72             : 
      73        1044 :       ifile = ifile + 1
      74        1044 :       CALL timeset(routineN, handle)
      75             :       CALL section_vals_val_get(param_section, "safe_computation", &
      76        1044 :                                 l_val=safe_computation)
      77             :       CALL section_vals_val_get(param_section, "aint_precond", &
      78        1044 :                                 i_val=aint_precond)
      79             :       CALL section_vals_val_get(param_section, "precond", &
      80        1044 :                                 i_val=precond_kind)
      81             :       CALL section_vals_val_get(param_section, "max_iter", &
      82        1044 :                                 i_val=max_iter)
      83             :       CALL section_vals_val_get(param_section, "eps_r", &
      84        1044 :                                 r_val=eps_r)
      85             :       CALL section_vals_val_get(param_section, "eps_x", &
      86        1044 :                                 r_val=eps_x)
      87             :       CALL section_vals_val_get(param_section, "kind", &
      88        1044 :                                 i_val=interp_kind)
      89             : 
      90        1044 :       pbc = (interp_kind == spline3_pbc_interp)
      91        1044 :       CPASSERT(pbc .OR. interp_kind == spline3_nopbc_interp)
      92       10440 :       bo = pw_coarse_out%pw_grid%bounds_local
      93        1044 :       NULLIFY (values, coeffs)
      94             :       CALL pw_pool_create_pw(coarse_pool, values, use_data=REALDATA3D, &
      95        1044 :                              in_space=REALSPACE)
      96        1044 :       CALL pw_zero(values)
      97             : 
      98             : !FM       nullify(tst_pw)
      99             : !FM       CALL pw_pool_create_pw(coarse_pool,tst_pw, use_data=REALDATA3D,&
     100             : !FM            in_space=REALSPACE)
     101             : !FM       call pw_copy(values,tst_pw)
     102             : !FM       call add_fine2coarse(fine_values_pw=pw_fine_in,&
     103             : !FM            coarse_coeffs_pw=tst_pw,&
     104             : !FM            weights_1d=spl3_1d_transf_coeffs/2._dp, w_border0=0.5_dp,&
     105             : !FM            w_border1=spl3_1d_transf_border1/2._dp,pbc=pbc,&
     106             : !FM            safe_computation=.false.)
     107             : 
     108             :       CALL add_fine2coarse(fine_values_pw=pw_fine_in, &
     109             :                            coarse_coeffs_pw=values, &
     110             :                            weights_1d=spl3_1d_transf_coeffs/2._dp, w_border0=0.5_dp, &
     111             :                            w_border1=spl3_1d_transf_border1/2._dp, pbc=pbc, &
     112        1044 :                            safe_computation=safe_computation)
     113             : 
     114             : !FM       CALL pw_compare_debug(tst_pw,values,max_diff)
     115             : !FM       WRITE(cp_logger_get_default_unit_nr(logger,.TRUE.),*)"f2cmax_diff=",max_diff
     116             : !FM       CALL pw_pool_give_back_pw(coarse_pool,tst_pw)
     117             : 
     118             :       CALL pw_pool_create_pw(coarse_pool, coeffs, use_data=REALDATA3D, &
     119        1044 :                              in_space=REALSPACE)
     120        1044 :       NULLIFY (precond)
     121             :       CALL pw_spline_precond_create(precond, precond_kind=aint_precond, &
     122        1044 :                                     pool=coarse_pool, pbc=pbc, transpose=.TRUE.)
     123        1044 :       CALL pw_spline_do_precond(precond, values, coeffs)
     124        1044 :       CALL pw_spline_precond_set_kind(precond, precond_kind)
     125        1044 :       IF (pbc) THEN
     126             :          success = find_coeffs(values=values, coeffs=coeffs, &
     127             :                                linOp=spl3_pbc, preconditioner=precond, pool=coarse_pool, &
     128           0 :                                eps_r=eps_r, eps_x=eps_x, max_iter=max_iter)
     129             :       ELSE
     130             :          success = find_coeffs(values=values, coeffs=coeffs, &
     131             :                                linOp=spl3_nopbct, preconditioner=precond, pool=coarse_pool, &
     132        1044 :                                eps_r=eps_r, eps_x=eps_x, max_iter=max_iter)
     133             :       END IF
     134        1044 :       CALL pw_spline_precond_release(precond)
     135             : 
     136        1044 :       CALL pw_zero(pw_coarse_out)
     137        1044 :       CALL pw_axpy(coeffs, pw_coarse_out)
     138             : 
     139        1044 :       CALL pw_pool_give_back_pw(coarse_pool, values)
     140        1044 :       CALL pw_pool_give_back_pw(coarse_pool, coeffs)
     141        1044 :       CALL timestop(handle)
     142        1044 :    END SUBROUTINE pw_restrict_s3
     143             : 
     144             : ! **************************************************************************************************
     145             : !> \brief prolongates a function from a coarse grid into a fine one
     146             : !> \param pw_coarse_in the coarse grid
     147             : !> \param pw_fine_out the fine grid
     148             : !> \param coarse_pool ...
     149             : !> \param param_section ...
     150             : !> \author fawzi
     151             : !> \note
     152             : !>      extremely slow (but correct) version
     153             : ! **************************************************************************************************
     154       17936 :    SUBROUTINE pw_prolongate_s3(pw_coarse_in, pw_fine_out, coarse_pool, &
     155             :                                param_section)
     156             :       TYPE(pw_type), POINTER                             :: pw_coarse_in, pw_fine_out
     157             :       TYPE(pw_pool_type), POINTER                        :: coarse_pool
     158             :       TYPE(section_vals_type), POINTER                   :: param_section
     159             : 
     160             :       CHARACTER(len=*), PARAMETER                        :: routineN = 'pw_prolongate_s3'
     161             : 
     162             :       INTEGER                                            :: aint_precond, handle, interp_kind, &
     163             :                                                             max_iter, precond_kind
     164             :       INTEGER, DIMENSION(2, 3)                           :: bo
     165             :       INTEGER, SAVE                                      :: ifile = 0
     166             :       LOGICAL                                            :: pbc, safe_computation, success
     167             :       REAL(kind=dp)                                      :: eps_r, eps_x
     168             :       TYPE(pw_spline_precond_type), POINTER              :: precond
     169             :       TYPE(pw_type), POINTER                             :: coeffs
     170             : 
     171        2242 :       ifile = ifile + 1
     172        2242 :       CALL timeset(routineN, handle)
     173        2242 :       NULLIFY (coeffs)
     174             :       CALL pw_pool_create_pw(coarse_pool, coeffs, use_data=REALDATA3D, &
     175        2242 :                              in_space=REALSPACE)
     176       22420 :       bo = pw_coarse_in%pw_grid%bounds_local
     177             :       CALL section_vals_val_get(param_section, "safe_computation", &
     178        2242 :                                 l_val=safe_computation)
     179             :       CALL section_vals_val_get(param_section, "aint_precond", &
     180        2242 :                                 i_val=aint_precond)
     181             :       CALL section_vals_val_get(param_section, "precond", &
     182        2242 :                                 i_val=precond_kind)
     183             :       CALL section_vals_val_get(param_section, "max_iter", &
     184        2242 :                                 i_val=max_iter)
     185             :       CALL section_vals_val_get(param_section, "eps_r", &
     186        2242 :                                 r_val=eps_r)
     187             :       CALL section_vals_val_get(param_section, "eps_x", &
     188        2242 :                                 r_val=eps_x)
     189             :       CALL section_vals_val_get(param_section, "kind", &
     190        2242 :                                 i_val=interp_kind)
     191             : 
     192        2242 :       pbc = (interp_kind == spline3_pbc_interp)
     193        2242 :       CPASSERT(pbc .OR. interp_kind == spline3_nopbc_interp)
     194        2242 :       NULLIFY (precond)
     195             :       CALL pw_spline_precond_create(precond, precond_kind=aint_precond, &
     196        2242 :                                     pool=coarse_pool, pbc=pbc, transpose=.FALSE.)
     197        2242 :       CALL pw_spline_do_precond(precond, pw_coarse_in, coeffs)
     198        2242 :       CALL pw_spline_precond_set_kind(precond, precond_kind)
     199        2242 :       IF (pbc) THEN
     200             :          success = find_coeffs(values=pw_coarse_in, coeffs=coeffs, &
     201             :                                linOp=spl3_pbc, preconditioner=precond, pool=coarse_pool, &
     202             :                                eps_r=eps_r, eps_x=eps_x, &
     203           0 :                                max_iter=max_iter)
     204             :       ELSE
     205             :          success = find_coeffs(values=pw_coarse_in, coeffs=coeffs, &
     206             :                                linOp=spl3_nopbc, preconditioner=precond, pool=coarse_pool, &
     207             :                                eps_r=eps_r, eps_x=eps_x, &
     208        2242 :                                max_iter=max_iter)
     209             :       END IF
     210        2242 :       CPASSERT(success)
     211        2242 :       CALL pw_spline_precond_release(precond)
     212             : 
     213             : !FM       nullify(tst_pw)
     214             : !FM       call pw_create(tst_pw, pw_fine_out%pw_grid, use_data=REALDATA3D,&
     215             : !FM            in_space=REALSPACE)
     216             : !FM       call pw_copy(pw_fine_out,tst_pw)
     217             : !FM       CALL add_coarse2fine(coarse_coeffs_pw=coeffs,&
     218             : !FM            fine_values_pw=tst_pw,&
     219             : !FM            weights_1d=spl3_1d_transf_coeffs,&
     220             : !FM            w_border0=1._dp,&
     221             : !FM            w_border1=spl3_1d_transf_border1,&
     222             : !FM            pbc=pbc,safe_computation=.false.,&
     223             : !FM
     224             : 
     225             :       CALL add_coarse2fine(coarse_coeffs_pw=coeffs, &
     226             :                            fine_values_pw=pw_fine_out, &
     227             :                            weights_1d=spl3_1d_transf_coeffs, &
     228             :                            w_border0=1._dp, &
     229             :                            w_border1=spl3_1d_transf_border1, &
     230        2242 :                            pbc=pbc, safe_computation=safe_computation)
     231             : 
     232             : !FM       CALL pw_compare_debug(tst_pw,pw_fine_out,max_diff)
     233             : !FM       WRITE(cp_logger_get_default_unit_nr(logger,.TRUE.),*)"c2fmax_diff=",max_diff
     234             : !FM       CALL pw_release(tst_pw)
     235             : 
     236        2242 :       CALL pw_pool_give_back_pw(coarse_pool, coeffs)
     237             : 
     238        2242 :       CALL timestop(handle)
     239        2242 :    END SUBROUTINE pw_prolongate_s3
     240             : 
     241             : END MODULE cp_spline_utils

Generated by: LCOV version 1.15