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             : 
       8             : MODULE input_cp2k_restarts_util
       9             :    USE cp_linked_list_input,            ONLY: cp_sll_val_create,&
      10             :                                               cp_sll_val_get_length,&
      11             :                                               cp_sll_val_type
      12             :    USE input_section_types,             ONLY: section_get_keyword_index,&
      13             :                                               section_type,&
      14             :                                               section_vals_add_values,&
      15             :                                               section_vals_type
      16             :    USE input_val_types,                 ONLY: val_create,&
      17             :                                               val_release,&
      18             :                                               val_type
      19             :    USE kinds,                           ONLY: dp
      20             :    USE particle_list_types,             ONLY: particle_list_type
      21             : #include "./base/base_uses.f90"
      22             : 
      23             :    IMPLICIT NONE
      24             : 
      25             :    PRIVATE
      26             : 
      27             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_restarts_util'
      28             : 
      29             :    PUBLIC :: section_velocity_val_set
      30             : 
      31             : CONTAINS
      32             : 
      33             : ! **************************************************************************************************
      34             : !> \brief routine to dump velocities.. fast implementation
      35             : !> \param velocity_section ...
      36             : !> \param particles ...
      37             : !> \param velocity ...
      38             : !> \param conv_factor ...
      39             : !> \par History
      40             : !>      02.2006 created [teo]
      41             : !> \author Teodoro Laino
      42             : ! **************************************************************************************************
      43        6154 :    SUBROUTINE section_velocity_val_set(velocity_section, particles, velocity, conv_factor)
      44             : 
      45             :       TYPE(section_vals_type), POINTER                   :: velocity_section
      46             :       TYPE(particle_list_type), OPTIONAL, POINTER        :: particles
      47             :       REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER  :: velocity
      48             :       REAL(KIND=dp)                                      :: conv_factor
      49             : 
      50             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'section_velocity_val_set'
      51             : 
      52             :       INTEGER                                            :: handle, ik, irk, Nlist, nloop
      53             :       LOGICAL                                            :: check
      54        6154 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: vel
      55             :       TYPE(cp_sll_val_type), POINTER                     :: new_pos, vals
      56             :       TYPE(section_type), POINTER                        :: section
      57             :       TYPE(val_type), POINTER                            :: my_val, old_val
      58             : 
      59        6154 :       CALL timeset(routineN, handle)
      60        6154 :       NULLIFY (my_val, old_val, section, vals)
      61        6154 :       CPASSERT(ASSOCIATED(velocity_section))
      62        6154 :       CPASSERT(velocity_section%ref_count > 0)
      63        6154 :       section => velocity_section%section
      64        6154 :       ik = section_get_keyword_index(section, "_DEFAULT_KEYWORD_")
      65        6154 :       IF (ik == -2) &
      66             :          CALL cp_abort(__LOCATION__, &
      67             :                        "section "//TRIM(section%name)//" does not contain keyword "// &
      68           0 :                        "_DEFAULT_KEYWORD_")
      69             : 
      70             :       ! At least one of the two arguments must be present..
      71        6154 :       check = PRESENT(particles) .NEQV. PRESENT(velocity)
      72        6154 :       CPASSERT(check)
      73        6154 :       IF (PRESENT(particles)) nloop = particles%n_els
      74        6154 :       IF (PRESENT(velocity)) nloop = SIZE(velocity, 2)
      75             : 
      76        1472 :       DO
      77        7626 :          IF (SIZE(velocity_section%values, 2) == 1) EXIT
      78        1472 :          CALL section_vals_add_values(velocity_section)
      79             :       END DO
      80        6154 :       vals => velocity_section%values(ik, 1)%list
      81        6154 :       Nlist = 0
      82        6154 :       IF (ASSOCIATED(vals)) THEN
      83        4682 :          Nlist = cp_sll_val_get_length(vals)
      84             :       END IF
      85      501836 :       DO irk = 1, nloop
      86      495682 :          ALLOCATE (vel(3))
      87             :          ! Always stored in A.U.
      88     1751122 :          IF (PRESENT(particles)) vel = particles%els(irk)%v(1:3)*conv_factor
      89     1036096 :          IF (PRESENT(velocity)) vel = velocity(1:3, irk)*conv_factor
      90             : 
      91      495682 :          CALL val_create(my_val, r_vals_ptr=vel)
      92             : 
      93      495682 :          IF (Nlist /= 0) THEN
      94      240256 :             IF (irk == 1) THEN
      95        4682 :                new_pos => vals
      96             :             ELSE
      97      235574 :                new_pos => new_pos%rest
      98             :             END IF
      99      240256 :             old_val => new_pos%first_el
     100      240256 :             CALL val_release(old_val)
     101      240256 :             new_pos%first_el => my_val
     102             :          ELSE
     103      255426 :             IF (irk == 1) THEN
     104        1472 :                NULLIFY (new_pos)
     105        1472 :                CALL cp_sll_val_create(new_pos, first_el=my_val)
     106        1472 :                vals => new_pos
     107             :             ELSE
     108      253954 :                NULLIFY (new_pos%rest)
     109      253954 :                CALL cp_sll_val_create(new_pos%rest, first_el=my_val)
     110      253954 :                new_pos => new_pos%rest
     111             :             END IF
     112             :          END IF
     113      501836 :          NULLIFY (my_val)
     114             :       END DO
     115             : 
     116        6154 :       velocity_section%values(ik, 1)%list => vals
     117             : 
     118        6154 :       CALL timestop(handle)
     119             : 
     120        6154 :    END SUBROUTINE section_velocity_val_set
     121             : 
     122             : END MODULE input_cp2k_restarts_util