LCOV - code coverage report
Current view: top level - src/pw - ps_wavelet_methods.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:cb5d5fc) Lines: 95.1 % 224 213
Test Date: 2026-04-24 07:01:27 Functions: 100.0 % 5 5

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2026 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief Definition and initialisation of the ps_wavelet data type.
      10              : !> \history 01.2014 Renamed from ps_wavelet_types to disentangle dependencies (Ole Schuett)
      11              : !> \author Florian Schiffmann (09.2007,fschiff)
      12              : ! **************************************************************************************************
      13              : MODULE ps_wavelet_methods
      14              : 
      15              :    USE bibliography,                    ONLY: Genovese2006,&
      16              :                                               Genovese2007,&
      17              :                                               cite_reference
      18              :    USE kinds,                           ONLY: dp
      19              :    USE ps_wavelet_kernel,               ONLY: createKernel
      20              :    USE ps_wavelet_types,                ONLY: WAVELET0D,&
      21              :                                               ps_wavelet_release,&
      22              :                                               ps_wavelet_type
      23              :    USE ps_wavelet_util,                 ONLY: F_FFT_dimensions,&
      24              :                                               PSolver,&
      25              :                                               P_FFT_dimensions,&
      26              :                                               S_FFT_dimensions
      27              :    USE pw_grid_types,                   ONLY: pw_grid_type
      28              :    USE pw_poisson_types,                ONLY: pw_poisson_parameter_type
      29              :    USE pw_types,                        ONLY: pw_r3d_rs_type
      30              :    USE util,                            ONLY: get_limit
      31              : #include "../base/base_uses.f90"
      32              : 
      33              :    IMPLICIT NONE
      34              : 
      35              :    PRIVATE
      36              : 
      37              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'ps_wavelet_methods'
      38              : 
      39              : ! *** Public data types ***
      40              : 
      41              :    PUBLIC :: ps_wavelet_create, &
      42              :              cp2k_distribution_to_z_slices, &
      43              :              z_slices_to_cp2k_distribution, &
      44              :              ps_wavelet_solve
      45              : 
      46              : CONTAINS
      47              : 
      48              : ! **************************************************************************************************
      49              : !> \brief creates the ps_wavelet_type which is needed for the link to
      50              : !>      the Poisson Solver of Luigi Genovese
      51              : !> \param poisson_params ...
      52              : !> \param wavelet wavelet to create
      53              : !> \param pw_grid the grid that is used to create the wavelet kernel
      54              : !> \author Flroian Schiffmann
      55              : ! **************************************************************************************************
      56          844 :    SUBROUTINE ps_wavelet_create(poisson_params, wavelet, pw_grid)
      57              :       TYPE(pw_poisson_parameter_type), INTENT(IN)        :: poisson_params
      58              :       TYPE(ps_wavelet_type), POINTER                     :: wavelet
      59              :       TYPE(pw_grid_type), POINTER                        :: pw_grid
      60              : 
      61              :       CHARACTER(len=*), PARAMETER                        :: routineN = 'ps_wavelet_create'
      62              : 
      63              :       INTEGER                                            :: handle, iproc, nproc, nx, ny, nz
      64              :       REAL(KIND=dp)                                      :: hx, hy, hz
      65              : 
      66          844 :       CALL timeset(routineN, handle)
      67              : 
      68          844 :       CALL cite_reference(Genovese2006)
      69          844 :       CALL cite_reference(Genovese2007)
      70              : 
      71          844 :       IF (ASSOCIATED(wavelet)) THEN
      72            0 :          CALL ps_wavelet_release(wavelet)
      73              :          NULLIFY (wavelet)
      74              :       END IF
      75              : 
      76         4220 :       ALLOCATE (wavelet)
      77              : 
      78          844 :       nx = pw_grid%npts(1)
      79          844 :       ny = pw_grid%npts(2)
      80          844 :       nz = pw_grid%npts(3)
      81              : 
      82          844 :       hx = pw_grid%dr(1)
      83          844 :       hy = pw_grid%dr(2)
      84          844 :       hz = pw_grid%dr(3)
      85              : 
      86         2532 :       nproc = PRODUCT(pw_grid%para%group%num_pe_cart)
      87              : 
      88          844 :       iproc = pw_grid%para%group%mepos
      89              : 
      90              :       NULLIFY (wavelet%karray, wavelet%rho_z_sliced)
      91              : 
      92          844 :       wavelet%geocode = poisson_params%wavelet_geocode
      93          844 :       wavelet%method = poisson_params%wavelet_method
      94          844 :       wavelet%special_dimension = poisson_params%wavelet_special_dimension
      95          844 :       wavelet%itype_scf = poisson_params%wavelet_scf_type
      96          844 :       wavelet%datacode = "D"
      97              : 
      98          844 :       IF (poisson_params%wavelet_method == WAVELET0D) THEN
      99          516 :          IF (hx /= hy) &
     100            0 :             CPABORT("Poisson solver for non cubic cells not yet implemented")
     101          516 :          IF (hz /= hy) &
     102            0 :             CPABORT("Poisson solver for non cubic cells not yet implemented")
     103              :       END IF
     104              : 
     105          844 :       CALL RS_z_slice_distribution(wavelet, pw_grid)
     106              : 
     107          844 :       CALL timestop(handle)
     108          844 :    END SUBROUTINE ps_wavelet_create
     109              : 
     110              : ! **************************************************************************************************
     111              : !> \brief ...
     112              : !> \param wavelet ...
     113              : !> \param pw_grid ...
     114              : ! **************************************************************************************************
     115          844 :    SUBROUTINE RS_z_slice_distribution(wavelet, pw_grid)
     116              : 
     117              :       TYPE(ps_wavelet_type), POINTER                     :: wavelet
     118              :       TYPE(pw_grid_type), POINTER                        :: pw_grid
     119              : 
     120              :       CHARACTER(len=*), PARAMETER :: routineN = 'RS_z_slice_distribution'
     121              : 
     122              :       CHARACTER(LEN=1)                                   :: geocode
     123              :       INTEGER                                            :: handle, iproc, m1, m2, m3, md1, md2, &
     124              :                                                             md3, n1, n2, n3, nd1, nd2, nd3, nproc, &
     125              :                                                             nx, ny, nz, z_dim
     126              :       REAL(KIND=dp)                                      :: hx, hy, hz
     127              : 
     128          844 :       CALL timeset(routineN, handle)
     129         2532 :       nproc = PRODUCT(pw_grid%para%group%num_pe_cart)
     130          844 :       iproc = pw_grid%para%group%mepos
     131          844 :       geocode = wavelet%geocode
     132          844 :       nx = pw_grid%npts(1)
     133          844 :       ny = pw_grid%npts(2)
     134          844 :       nz = pw_grid%npts(3)
     135          844 :       hx = pw_grid%dr(1)
     136          844 :       hy = pw_grid%dr(2)
     137          844 :       hz = pw_grid%dr(3)
     138              : 
     139              :       !calculate Dimensions for the z-distributed density and for the kernel
     140              : 
     141          844 :       IF (geocode == 'P') THEN
     142          326 :          CALL P_FFT_dimensions(nx, ny, nz, m1, m2, m3, n1, n2, n3, md1, md2, md3, nd1, nd2, nd3, nproc)
     143          518 :       ELSE IF (geocode == 'S') THEN
     144            2 :          CALL S_FFT_dimensions(nx, ny, nz, m1, m2, m3, n1, n2, n3, md1, md2, md3, nd1, nd2, nd3, nproc)
     145          516 :       ELSE IF (geocode == 'F') THEN
     146          516 :          CALL F_FFT_dimensions(nx, ny, nz, m1, m2, m3, n1, n2, n3, md1, md2, md3, nd1, nd2, nd3, nproc)
     147              :       END IF
     148              : 
     149          844 :       wavelet%PS_grid(1) = md1
     150          844 :       wavelet%PS_grid(2) = md3
     151          844 :       wavelet%PS_grid(3) = md2
     152          844 :       z_dim = md2/nproc
     153              :       !!!!!!!!!      indices y and z are interchanged    !!!!!!!
     154         4220 :       ALLOCATE (wavelet%rho_z_sliced(md1, md3, z_dim))
     155              : 
     156              :       CALL createKernel(geocode, nx, ny, nz, hx, hy, hz, wavelet%itype_scf, iproc, nproc, wavelet%karray, &
     157          844 :                         pw_grid%para%group)
     158              : 
     159          844 :       CALL timestop(handle)
     160          844 :    END SUBROUTINE RS_z_slice_distribution
     161              : 
     162              : ! **************************************************************************************************
     163              : !> \brief ...
     164              : !> \param density ...
     165              : !> \param wavelet ...
     166              : !> \param pw_grid ...
     167              : ! **************************************************************************************************
     168        33065 :    SUBROUTINE cp2k_distribution_to_z_slices(density, wavelet, pw_grid)
     169              : 
     170              :       TYPE(pw_r3d_rs_type), INTENT(IN)                   :: density
     171              :       TYPE(ps_wavelet_type), POINTER                     :: wavelet
     172              :       TYPE(pw_grid_type), POINTER                        :: pw_grid
     173              : 
     174              :       CHARACTER(len=*), PARAMETER :: routineN = 'cp2k_distribution_to_z_slices'
     175              : 
     176              :       INTEGER                                            :: dest, handle, i, ii, iproc, j, k, l, &
     177              :                                                             local_z_dim, loz, m, m2, md2, nproc, &
     178              :                                                             should_warn
     179        33065 :       INTEGER, ALLOCATABLE, DIMENSION(:)                 :: rcount, rdispl, scount, sdispl, tmp
     180              :       INTEGER, DIMENSION(2)                              :: cart_pos, lox, loy
     181              :       INTEGER, DIMENSION(3)                              :: lb, ub
     182              :       REAL(KIND=dp)                                      :: max_val_low, max_val_up
     183        33065 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: rbuf, sbuf
     184              : 
     185        33065 :       CALL timeset(routineN, handle)
     186              : 
     187        33065 :       CPASSERT(ASSOCIATED(wavelet))
     188              : 
     189        99195 :       nproc = PRODUCT(pw_grid%para%group%num_pe_cart)
     190        33065 :       iproc = pw_grid%para%group%mepos
     191        33065 :       md2 = wavelet%PS_grid(3)
     192        33065 :       m2 = pw_grid%npts(3)
     193       132260 :       lb(:) = pw_grid%bounds_local(1, :)
     194       132260 :       ub(:) = pw_grid%bounds_local(2, :)
     195        33065 :       local_z_dim = MAX((md2/nproc), 1)
     196              : 
     197       198390 :       ALLOCATE (sbuf(PRODUCT(pw_grid%npts_local)))
     198       198390 :       ALLOCATE (rbuf(PRODUCT(wavelet%PS_grid)/nproc))
     199       231455 :       ALLOCATE (scount(nproc), sdispl(nproc), rcount(nproc), rdispl(nproc), tmp(nproc))
     200              : 
     201    955704738 :       rbuf = 0.0_dp
     202        33065 :       ii = 1
     203       973478 :       DO k = lb(3), ub(3)
     204     34133203 :          DO j = lb(2), ub(2)
     205    969213833 :             DO i = lb(1), ub(1)
     206    935113695 :                sbuf(ii) = density%array(i, j, k)
     207    968273420 :                ii = ii + 1
     208              :             END DO
     209              :          END DO
     210              :       END DO
     211              : 
     212        33065 :       should_warn = 0
     213        33065 :       IF (wavelet%geocode == 'S' .OR. wavelet%geocode == 'F') THEN
     214        15742 :          max_val_low = 0._dp
     215        15742 :          max_val_up = 0._dp
     216     16909227 :          IF (lb(2) == pw_grid%bounds(1, 2)) max_val_low = MAXVAL(ABS(density%array(:, lb(2), :)))
     217     16909227 :          IF (ub(2) == pw_grid%bounds(2, 2)) max_val_up = MAXVAL(ABS(density%array(:, ub(2), :)))
     218        15742 :          IF (max_val_low >= 0.0001_dp) should_warn = 1
     219        15742 :          IF (max_val_up >= 0.0001_dp) should_warn = 1
     220        15742 :          IF (wavelet%geocode == 'F') THEN
     221        15724 :             max_val_low = 0._dp
     222        15724 :             max_val_up = 0._dp
     223     16492560 :             IF (lb(1) == pw_grid%bounds(1, 1)) max_val_low = MAXVAL(ABS(density%array(lb(1), :, :)))
     224     16492560 :             IF (ub(1) == pw_grid%bounds(2, 1)) max_val_up = MAXVAL(ABS(density%array(ub(1), :, :)))
     225        15724 :             IF (max_val_low >= 0.0001_dp) should_warn = 1
     226        15724 :             IF (max_val_up >= 0.0001_dp) should_warn = 1
     227        15724 :             max_val_low = 0._dp
     228        15724 :             max_val_up = 0._dp
     229     16670097 :             IF (lb(3) == pw_grid%bounds(1, 3)) max_val_low = MAXVAL(ABS(density%array(:, :, lb(3))))
     230     16670097 :             IF (ub(3) == pw_grid%bounds(2, 3)) max_val_up = MAXVAL(ABS(density%array(:, :, ub(3))))
     231        15724 :             IF (max_val_low >= 0.0001_dp) should_warn = 1
     232        15724 :             IF (max_val_up >= 0.0001_dp) should_warn = 1
     233              :          END IF
     234              :       END IF
     235              : 
     236        33065 :       CALL pw_grid%para%group%max(should_warn)
     237        33065 :       IF (should_warn > 0 .AND. iproc == 0) THEN
     238         4489 :          CPWARN("Density non-zero on the edges of the unit cell: wrong results in WAVELET solver")
     239              :       END IF
     240        79112 :       DO i = 0, pw_grid%para%group%num_pe_cart(1) - 1
     241       125159 :          DO j = 0, pw_grid%para%group%num_pe_cart(2) - 1
     242       138141 :             cart_pos = [i, j]
     243        46047 :             CALL pw_grid%para%group%rank_cart(cart_pos, dest)
     244        46047 :             IF ((ub(1) >= lb(1)) .AND. (ub(2) >= lb(2))) THEN
     245        46047 :                IF (dest*local_z_dim <= m2) THEN
     246        46047 :                   IF ((dest + 1)*local_z_dim <= m2) THEN
     247        41480 :                      scount(dest + 1) = ABS((ub(1) - lb(1) + 1)*(ub(2) - lb(2) + 1)*local_z_dim)
     248              :                   ELSE
     249         4567 :                      scount(dest + 1) = ABS((ub(1) - lb(1) + 1)*(ub(2) - lb(2) + 1)*MOD(m2, local_z_dim))
     250              :                   END IF
     251              :                ELSE
     252            0 :                   scount(dest + 1) = 0
     253              :                END IF
     254              :             ELSE
     255            0 :                scount(dest + 1) = 0
     256              :             END IF
     257        46047 :             lox = get_limit(pw_grid%npts(1), pw_grid%para%group%num_pe_cart(1), i)
     258        46047 :             loy = get_limit(pw_grid%npts(2), pw_grid%para%group%num_pe_cart(2), j)
     259        92094 :             IF ((lox(2) >= lox(1)) .AND. (loy(2) >= loy(1))) THEN
     260        46047 :                IF (iproc*local_z_dim <= m2) THEN
     261        46047 :                   IF ((iproc + 1)*local_z_dim <= m2) THEN
     262        41480 :                      rcount(dest + 1) = ABS((lox(2) - lox(1) + 1)*(loy(2) - loy(1) + 1)*local_z_dim)
     263              :                   ELSE
     264         4567 :                      rcount(dest + 1) = ABS((lox(2) - lox(1) + 1)*(loy(2) - loy(1) + 1)*MOD(m2, local_z_dim))
     265              :                   END IF
     266              :                ELSE
     267            0 :                   rcount(dest + 1) = 0
     268              :                END IF
     269              :             ELSE
     270            0 :                rcount(dest + 1) = 0
     271              :             END IF
     272              : 
     273              :          END DO
     274              :       END DO
     275        33065 :       sdispl(1) = 0
     276        33065 :       rdispl(1) = 0
     277        46047 :       DO i = 2, nproc
     278        12982 :          sdispl(i) = sdispl(i - 1) + scount(i - 1)
     279        46047 :          rdispl(i) = rdispl(i - 1) + rcount(i - 1)
     280              :       END DO
     281   2846490106 :       CALL pw_grid%para%group%alltoall(sbuf, scount, sdispl, rbuf, rcount, rdispl)
     282              :       !!!! and now, how to put the right cubes to the right position!!!!!!
     283              : 
     284    979985512 :       wavelet%rho_z_sliced = 0.0_dp
     285              : 
     286        79112 :       DO i = 0, pw_grid%para%group%num_pe_cart(1) - 1
     287       125159 :          DO j = 0, pw_grid%para%group%num_pe_cart(2) - 1
     288       138141 :             cart_pos = [i, j]
     289        46047 :             CALL pw_grid%para%group%rank_cart(cart_pos, dest)
     290              : 
     291        46047 :             lox = get_limit(pw_grid%npts(1), pw_grid%para%group%num_pe_cart(1), i)
     292        46047 :             loy = get_limit(pw_grid%npts(2), pw_grid%para%group%num_pe_cart(2), j)
     293        92094 :             IF (iproc*local_z_dim <= m2) THEN
     294        46047 :                IF ((iproc + 1)*local_z_dim <= m2) THEN
     295              :                   loz = local_z_dim
     296              :                ELSE
     297         4567 :                   loz = MOD(m2, local_z_dim)
     298              :                END IF
     299        46047 :                ii = 1
     300       986460 :                DO k = 1, loz
     301     34146185 :                   DO l = loy(1), loy(2)
     302    969213833 :                      DO m = lox(1), lox(2)
     303    935113695 :                         wavelet%rho_z_sliced(m, l, k) = rbuf(ii + rdispl(dest + 1))
     304    968273420 :                         ii = ii + 1
     305              :                      END DO
     306              :                   END DO
     307              :                END DO
     308              :             END IF
     309              :          END DO
     310              :       END DO
     311              : 
     312        33065 :       DEALLOCATE (sbuf, rbuf, scount, sdispl, rcount, rdispl, tmp)
     313              : 
     314        33065 :       CALL timestop(handle)
     315              : 
     316        33065 :    END SUBROUTINE cp2k_distribution_to_z_slices
     317              : 
     318              : ! **************************************************************************************************
     319              : !> \brief ...
     320              : !> \param density ...
     321              : !> \param wavelet ...
     322              : !> \param pw_grid ...
     323              : ! **************************************************************************************************
     324        33065 :    SUBROUTINE z_slices_to_cp2k_distribution(density, wavelet, pw_grid)
     325              : 
     326              :       TYPE(pw_r3d_rs_type), INTENT(IN)                   :: density
     327              :       TYPE(ps_wavelet_type), POINTER                     :: wavelet
     328              :       TYPE(pw_grid_type), POINTER                        :: pw_grid
     329              : 
     330              :       INTEGER                                            :: dest, i, ii, iproc, j, k, l, &
     331              :                                                             local_z_dim, loz, m, m2, md2, nproc
     332        33065 :       INTEGER, ALLOCATABLE, DIMENSION(:)                 :: rcount, rdispl, scount, sdispl, tmp
     333              :       INTEGER, DIMENSION(2)                              :: cart_pos, lox, loy, min_x, min_y
     334              :       INTEGER, DIMENSION(3)                              :: lb, ub
     335        33065 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: rbuf, sbuf
     336              : 
     337            0 :       CPASSERT(ASSOCIATED(wavelet))
     338              : 
     339        99195 :       nproc = PRODUCT(pw_grid%para%group%num_pe_cart)
     340        33065 :       iproc = pw_grid%para%group%mepos
     341        33065 :       md2 = wavelet%PS_grid(3)
     342        33065 :       m2 = pw_grid%npts(3)
     343              : 
     344       132260 :       lb(:) = pw_grid%bounds_local(1, :)
     345       132260 :       ub(:) = pw_grid%bounds_local(2, :)
     346              : 
     347        33065 :       local_z_dim = MAX((md2/nproc), 1)
     348              : 
     349       198390 :       ALLOCATE (rbuf(PRODUCT(pw_grid%npts_local)))
     350       198390 :       ALLOCATE (sbuf(PRODUCT(wavelet%PS_grid)/nproc))
     351       231455 :       ALLOCATE (scount(nproc), sdispl(nproc), rcount(nproc), rdispl(nproc), tmp(nproc))
     352        79112 :       scount = 0
     353        79112 :       rcount = 0
     354    935146760 :       rbuf = 0.0_dp
     355        33065 :       ii = 1
     356        33065 :       IF (iproc*local_z_dim <= m2) THEN
     357        33065 :          IF ((iproc + 1)*local_z_dim <= m2) THEN
     358              :             loz = local_z_dim
     359              :          ELSE
     360         2793 :             loz = MOD(m2, local_z_dim)
     361              :          END IF
     362              :       ELSE
     363              :          loz = 0
     364              :       END IF
     365              : 
     366        33065 :       min_x = get_limit(pw_grid%npts(1), pw_grid%para%group%num_pe_cart(1), 0)
     367        33065 :       min_y = get_limit(pw_grid%npts(2), pw_grid%para%group%num_pe_cart(2), 0)
     368        79112 :       DO i = 0, pw_grid%para%group%num_pe_cart(1) - 1
     369       125159 :          DO j = 0, pw_grid%para%group%num_pe_cart(2) - 1
     370       138141 :             cart_pos = [i, j]
     371        46047 :             CALL pw_grid%para%group%rank_cart(cart_pos, dest)
     372        46047 :             IF ((ub(1) >= lb(1)) .AND. (ub(2) >= lb(2))) THEN
     373        46047 :                IF (dest*local_z_dim <= m2) THEN
     374        46047 :                   IF ((dest + 1)*local_z_dim <= m2) THEN
     375        41480 :                      rcount(dest + 1) = ABS((ub(1) - lb(1) + 1)*(ub(2) - lb(2) + 1)*local_z_dim)
     376              :                   ELSE
     377         4567 :                      rcount(dest + 1) = ABS((ub(1) - lb(1) + 1)*(ub(2) - lb(2) + 1)*MOD(m2, local_z_dim))
     378              :                   END IF
     379              :                ELSE
     380            0 :                   rcount(dest + 1) = 0
     381              :                END IF
     382              :             ELSE
     383            0 :                rcount(dest + 1) = 0
     384              :             END IF
     385        46047 :             lox = get_limit(pw_grid%npts(1), pw_grid%para%group%num_pe_cart(1), i)
     386        46047 :             loy = get_limit(pw_grid%npts(2), pw_grid%para%group%num_pe_cart(2), j)
     387        92094 :             IF ((lox(2) >= lox(1)) .AND. (loy(2) >= loy(1))) THEN
     388        46047 :                scount(dest + 1) = ABS((lox(2) - lox(1) + 1)*(loy(2) - loy(1) + 1)*loz)
     389       986460 :                DO k = lox(1) - min_x(1) + 1, lox(2) - min_x(1) + 1
     390     34146185 :                   DO l = loy(1) - min_y(1) + 1, loy(2) - min_y(1) + 1
     391    969213833 :                      DO m = 1, loz
     392    935113695 :                         sbuf(ii) = wavelet%rho_z_sliced(k, l, m)
     393    968273420 :                         ii = ii + 1
     394              :                      END DO
     395              :                   END DO
     396              :                END DO
     397              :             ELSE
     398            0 :                scount(dest + 1) = 0
     399              :             END IF
     400              :          END DO
     401              :       END DO
     402        33065 :       sdispl(1) = 0
     403        33065 :       rdispl(1) = 0
     404        46047 :       DO i = 2, nproc
     405        12982 :          sdispl(i) = sdispl(i - 1) + scount(i - 1)
     406        46047 :          rdispl(i) = rdispl(i - 1) + rcount(i - 1)
     407              :       END DO
     408   2825932128 :       CALL pw_grid%para%group%alltoall(sbuf, scount, sdispl, rbuf, rcount, rdispl)
     409              : 
     410              :       !!!! and now, how to put the right cubes to the right position!!!!!!
     411              : 
     412        79112 :       DO i = 0, pw_grid%para%group%num_pe_cart(1) - 1
     413       125159 :          DO j = 0, pw_grid%para%group%num_pe_cart(2) - 1
     414       138141 :             cart_pos = [i, j]
     415        46047 :             CALL pw_grid%para%group%rank_cart(cart_pos, dest)
     416        92094 :             IF (dest*local_z_dim <= m2) THEN
     417        46047 :                IF ((dest + 1)*local_z_dim <= m2) THEN
     418              :                   loz = local_z_dim
     419              :                ELSE
     420         4567 :                   loz = MOD(m2, local_z_dim)
     421              :                END IF
     422        46047 :                ii = 1
     423        46047 :                IF (lb(3) + (dest*local_z_dim) <= ub(3)) THEN
     424       986460 :                   DO m = lb(1), ub(1)
     425     34146185 :                      DO l = lb(2), ub(2)
     426    969213833 :                         DO k = lb(3) + (dest*local_z_dim), lb(3) + (dest*local_z_dim) + loz - 1
     427    935113695 :                            density%array(m, l, k) = rbuf(ii + rdispl(dest + 1))
     428    968273420 :                            ii = ii + 1
     429              :                         END DO
     430              :                      END DO
     431              :                   END DO
     432              :                END IF
     433              :             END IF
     434              :          END DO
     435              :       END DO
     436        33065 :       DEALLOCATE (sbuf, rbuf, scount, sdispl, rcount, rdispl, tmp)
     437              : 
     438        33065 :    END SUBROUTINE z_slices_to_cp2k_distribution
     439              : 
     440              : ! **************************************************************************************************
     441              : !> \brief ...
     442              : !> \param wavelet ...
     443              : !> \param pw_grid ...
     444              : ! **************************************************************************************************
     445        33065 :    SUBROUTINE ps_wavelet_solve(wavelet, pw_grid)
     446              : 
     447              :       TYPE(ps_wavelet_type), POINTER                     :: wavelet
     448              :       TYPE(pw_grid_type), POINTER                        :: pw_grid
     449              : 
     450              :       CHARACTER(len=*), PARAMETER                        :: routineN = 'ps_wavelet_solve'
     451              : 
     452              :       CHARACTER(LEN=1)                                   :: geocode
     453              :       INTEGER                                            :: handle, iproc, nproc, nx, ny, nz
     454              :       REAL(KIND=dp)                                      :: hx, hy, hz
     455              : 
     456        33065 :       CALL timeset(routineN, handle)
     457        99195 :       nproc = PRODUCT(pw_grid%para%group%num_pe_cart)
     458        33065 :       iproc = pw_grid%para%group%mepos
     459        33065 :       geocode = wavelet%geocode
     460        33065 :       nx = pw_grid%npts(1)
     461        33065 :       ny = pw_grid%npts(2)
     462        33065 :       nz = pw_grid%npts(3)
     463        33065 :       hx = pw_grid%dr(1)
     464        33065 :       hy = pw_grid%dr(2)
     465        33065 :       hz = pw_grid%dr(3)
     466              : 
     467              :       CALL PSolver(geocode, iproc, nproc, nx, ny, nz, hx, hy, hz, &
     468        33065 :                    wavelet%rho_z_sliced, wavelet%karray, pw_grid)
     469        33065 :       CALL timestop(handle)
     470        33065 :    END SUBROUTINE ps_wavelet_solve
     471              : 
     472              : END MODULE ps_wavelet_methods
        

Generated by: LCOV version 2.0-1