LCOV - code coverage report
Current view: top level - src - motion_utils.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:4dc10b3) Lines: 265 274 96.7 %
Date: 2024-11-21 06:45:46 Functions: 5 5 100.0 %

          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             : ! **************************************************************************************************
       9             : !> \brief  Output Utilities for MOTION_SECTION
      10             : !> \author Teodoro Laino [tlaino] - University of Zurich
      11             : !> \date   02.2008
      12             : ! **************************************************************************************************
      13             : MODULE motion_utils
      14             : 
      15             :    USE cell_types,                      ONLY: cell_type
      16             :    USE cp2k_info,                       ONLY: compile_revision,&
      17             :                                               cp2k_version,&
      18             :                                               r_datx,&
      19             :                                               r_host_name,&
      20             :                                               r_user_name
      21             :    USE cp_log_handling,                 ONLY: cp_get_default_logger,&
      22             :                                               cp_logger_type
      23             :    USE cp_output_handling,              ONLY: cp_print_key_finished_output,&
      24             :                                               cp_print_key_unit_nr
      25             :    USE cp_subsys_types,                 ONLY: cp_subsys_get,&
      26             :                                               cp_subsys_type
      27             :    USE cp_units,                        ONLY: cp_unit_from_cp2k
      28             :    USE force_env_types,                 ONLY: force_env_get,&
      29             :                                               force_env_type
      30             :    USE input_constants,                 ONLY: dump_atomic,&
      31             :                                               dump_dcd,&
      32             :                                               dump_dcd_aligned_cell,&
      33             :                                               dump_pdb,&
      34             :                                               dump_xmol
      35             :    USE input_section_types,             ONLY: section_get_ival,&
      36             :                                               section_vals_get,&
      37             :                                               section_vals_get_subs_vals,&
      38             :                                               section_vals_type,&
      39             :                                               section_vals_val_get
      40             :    USE kinds,                           ONLY: default_string_length,&
      41             :                                               dp,&
      42             :                                               sp
      43             :    USE machine,                         ONLY: m_flush
      44             :    USE mathlib,                         ONLY: diamat_all
      45             :    USE particle_list_types,             ONLY: particle_list_type
      46             :    USE particle_methods,                ONLY: write_particle_coordinates
      47             :    USE particle_types,                  ONLY: particle_type
      48             :    USE physcon,                         ONLY: angstrom
      49             :    USE virial_types,                    ONLY: virial_type
      50             : #include "./base/base_uses.f90"
      51             : 
      52             :    IMPLICIT NONE
      53             : 
      54             :    PRIVATE
      55             : 
      56             :    PUBLIC :: write_trajectory, write_stress_tensor_to_file, write_simulation_cell, &
      57             :              get_output_format, rot_ana
      58             : 
      59             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'motion_utils'
      60             :    REAL(KIND=dp), PARAMETER, PUBLIC     :: thrs_motion = 5.0E-10_dp
      61             : 
      62             : CONTAINS
      63             : 
      64             : ! **************************************************************************************************
      65             : !> \brief Performs an analysis of the principal inertia axis
      66             : !>      Getting back the generators of the translating and
      67             : !>      rotating frame
      68             : !> \param particles ...
      69             : !> \param mat ...
      70             : !> \param dof ...
      71             : !> \param print_section ...
      72             : !> \param keep_rotations ...
      73             : !> \param mass_weighted ...
      74             : !> \param natoms ...
      75             : !> \param rot_dof ...
      76             : !> \param inertia ...
      77             : !> \author Teodoro Laino 08.2006
      78             : ! **************************************************************************************************
      79        2162 :    SUBROUTINE rot_ana(particles, mat, dof, print_section, keep_rotations, mass_weighted, &
      80             :                       natoms, rot_dof, inertia)
      81             :       TYPE(particle_type), DIMENSION(:), POINTER         :: particles
      82             :       REAL(KIND=dp), DIMENSION(:, :), OPTIONAL, POINTER  :: mat
      83             :       INTEGER, INTENT(OUT)                               :: dof
      84             :       TYPE(section_vals_type), POINTER                   :: print_section
      85             :       LOGICAL, INTENT(IN)                                :: keep_rotations, mass_weighted
      86             :       INTEGER, INTENT(IN)                                :: natoms
      87             :       INTEGER, INTENT(OUT), OPTIONAL                     :: rot_dof
      88             :       REAL(KIND=dp), INTENT(OUT), OPTIONAL               :: inertia(3)
      89             : 
      90             :       CHARACTER(len=*), PARAMETER                        :: routineN = 'rot_ana'
      91             : 
      92             :       INTEGER                                            :: handle, i, iparticle, iseq, iw, j, k, &
      93             :                                                             lrot(3)
      94             :       LOGICAL                                            :: present_mat
      95             :       REAL(KIND=dp)                                      :: cp(3), Ip(3, 3), Ip_eigval(3), mass, &
      96             :                                                             masst, norm, rcom(3), rm(3)
      97        2162 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: Rot, Tr
      98             :       TYPE(cp_logger_type), POINTER                      :: logger
      99             : 
     100        2162 :       CALL timeset(routineN, handle)
     101        2162 :       logger => cp_get_default_logger()
     102        2162 :       present_mat = PRESENT(mat)
     103        2162 :       CPASSERT(ASSOCIATED(particles))
     104        2162 :       IF (present_mat) THEN
     105         376 :          CPASSERT(.NOT. ASSOCIATED(mat))
     106             :       END IF
     107        2162 :       IF (.NOT. keep_rotations) THEN
     108        2160 :          rcom = 0.0_dp
     109        2160 :          masst = 0.0_dp
     110             :          ! Center of mass
     111      489724 :          DO iparticle = 1, natoms
     112      487564 :             mass = 1.0_dp
     113      487564 :             IF (mass_weighted) mass = particles(iparticle)%atomic_kind%mass
     114      487564 :             CPASSERT(mass >= 0.0_dp)
     115      487564 :             masst = masst + mass
     116     1952416 :             rcom = particles(iparticle)%r*mass + rcom
     117             :          END DO
     118        2160 :          CPASSERT(masst > 0.0_dp)
     119        8640 :          rcom = rcom/masst
     120             :          ! Intertia Tensor
     121        2160 :          Ip = 0.0_dp
     122      489724 :          DO iparticle = 1, natoms
     123      487564 :             mass = 1.0_dp
     124      487564 :             IF (mass_weighted) mass = particles(iparticle)%atomic_kind%mass
     125     1950256 :             rm = particles(iparticle)%r - rcom
     126      487564 :             Ip(1, 1) = Ip(1, 1) + mass*(rm(2)**2 + rm(3)**2)
     127      487564 :             Ip(2, 2) = Ip(2, 2) + mass*(rm(1)**2 + rm(3)**2)
     128      487564 :             Ip(3, 3) = Ip(3, 3) + mass*(rm(1)**2 + rm(2)**2)
     129      487564 :             Ip(1, 2) = Ip(1, 2) - mass*(rm(1)*rm(2))
     130      487564 :             Ip(1, 3) = Ip(1, 3) - mass*(rm(1)*rm(3))
     131      489724 :             Ip(2, 3) = Ip(2, 3) - mass*(rm(2)*rm(3))
     132             :          END DO
     133             :          ! Diagonalize the Inertia Tensor
     134        2160 :          CALL diamat_all(Ip, Ip_eigval)
     135        2160 :          IF (PRESENT(inertia)) inertia = Ip_eigval
     136        2160 :          iw = cp_print_key_unit_nr(logger, print_section, "ROTATIONAL_INFO", extension=".vibLog")
     137        2160 :          IF (iw > 0) THEN
     138             :             WRITE (UNIT=iw, FMT='(/,T2,A)') &
     139         989 :                'ROT| Rotational analysis information'
     140             :             WRITE (UNIT=iw, FMT='(T2,A)') &
     141         989 :                'ROT| Principal axes and moments of inertia [a.u.]'
     142             :             WRITE (UNIT=iw, FMT='(T2,A,T14,3(1X,I19))') &
     143         989 :                'ROT|', 1, 2, 3
     144             :             WRITE (UNIT=iw, FMT='(T2,A,T21,3(1X,ES19.11))') &
     145         989 :                'ROT| Eigenvalues', Ip_eigval(1:3)
     146             :             WRITE (UNIT=iw, FMT='(T2,A,T21,3(1X,F19.12))') &
     147         989 :                'ROT|      x', Ip(1, 1:3)
     148             :             WRITE (UNIT=iw, FMT='(T2,A,T21,3(1X,F19.12))') &
     149         989 :                'ROT|      y', Ip(2, 1:3)
     150             :             WRITE (UNIT=iw, FMT='(T2,A,T21,3(1X,F19.12))') &
     151         989 :                'ROT|      z', Ip(3, 1:3)
     152             :          END IF
     153        2160 :          CALL cp_print_key_finished_output(iw, logger, print_section, "ROTATIONAL_INFO")
     154        2160 :          iw = cp_print_key_unit_nr(logger, print_section, "ROTATIONAL_INFO/COORDINATES", extension=".vibLog")
     155        2160 :          IF (iw > 0) THEN
     156          62 :             WRITE (UNIT=iw, FMT='(/,T2,A)') 'ROT| Standard molecule orientation in Angstrom'
     157         428 :             DO iparticle = 1, natoms
     158             :                WRITE (UNIT=iw, FMT='(T2,"ROT|",T20,A,T27,3(3X,F15.9))') &
     159         366 :                   TRIM(particles(iparticle)%atomic_kind%name), &
     160        6284 :                   MATMUL(particles(iparticle)%r, Ip)*angstrom
     161             :             END DO
     162             :          END IF
     163        2160 :          CALL cp_print_key_finished_output(iw, logger, print_section, "ROTATIONAL_INFO/COORDINATES")
     164             :       END IF
     165             :       ! Build up the Translational vectors
     166        8648 :       ALLOCATE (Tr(natoms*3, 3))
     167     4396778 :       Tr = 0.0_dp
     168        8648 :       DO k = 1, 3
     169             :          iseq = 0
     170     1471358 :          DO iparticle = 1, natoms
     171     1462710 :             mass = 1.0_dp
     172     1462710 :             IF (mass_weighted) mass = SQRT(particles(iparticle)%atomic_kind%mass)
     173     5857326 :             DO j = 1, 3
     174     4388130 :                iseq = iseq + 1
     175     5850840 :                IF (j == k) Tr(iseq, k) = mass
     176             :             END DO
     177             :          END DO
     178             :       END DO
     179             :       ! Normalize Translations
     180        8648 :       DO i = 1, 3
     181     4394616 :          norm = SQRT(DOT_PRODUCT(Tr(:, i), Tr(:, i)))
     182     4396778 :          Tr(:, i) = Tr(:, i)/norm
     183             :       END DO
     184        2162 :       dof = 3
     185             :       ! Build up the Rotational vectors
     186        4324 :       ALLOCATE (Rot(natoms*3, 3))
     187        2162 :       lrot = 0
     188        2162 :       IF (.NOT. keep_rotations) THEN
     189      489724 :          DO iparticle = 1, natoms
     190      487564 :             mass = 1.0_dp
     191      487564 :             IF (mass_weighted) mass = SQRT(particles(iparticle)%atomic_kind%mass)
     192     1950256 :             rm = particles(iparticle)%r - rcom
     193      487564 :             cp(1) = rm(1)*Ip(1, 1) + rm(2)*Ip(2, 1) + rm(3)*Ip(3, 1)
     194      487564 :             cp(2) = rm(1)*Ip(1, 2) + rm(2)*Ip(2, 2) + rm(3)*Ip(3, 2)
     195      487564 :             cp(3) = rm(1)*Ip(1, 3) + rm(2)*Ip(2, 3) + rm(3)*Ip(3, 3)
     196             :             ! X Rot
     197      487564 :             Rot((iparticle - 1)*3 + 1, 1) = (cp(2)*Ip(1, 3) - Ip(1, 2)*cp(3))*mass
     198      487564 :             Rot((iparticle - 1)*3 + 2, 1) = (cp(2)*Ip(2, 3) - Ip(2, 2)*cp(3))*mass
     199      487564 :             Rot((iparticle - 1)*3 + 3, 1) = (cp(2)*Ip(3, 3) - Ip(3, 2)*cp(3))*mass
     200             :             ! Y Rot
     201      487564 :             Rot((iparticle - 1)*3 + 1, 2) = (cp(3)*Ip(1, 1) - Ip(1, 3)*cp(1))*mass
     202      487564 :             Rot((iparticle - 1)*3 + 2, 2) = (cp(3)*Ip(2, 1) - Ip(2, 3)*cp(1))*mass
     203      487564 :             Rot((iparticle - 1)*3 + 3, 2) = (cp(3)*Ip(3, 1) - Ip(3, 3)*cp(1))*mass
     204             :             ! Z Rot
     205      487564 :             Rot((iparticle - 1)*3 + 1, 3) = (cp(1)*Ip(1, 2) - Ip(1, 1)*cp(2))*mass
     206      487564 :             Rot((iparticle - 1)*3 + 2, 3) = (cp(1)*Ip(2, 2) - Ip(2, 1)*cp(2))*mass
     207      489724 :             Rot((iparticle - 1)*3 + 3, 3) = (cp(1)*Ip(3, 2) - Ip(3, 1)*cp(2))*mass
     208             :          END DO
     209             : 
     210             :          ! Normalize Rotations and count the number of degree of freedom
     211        8640 :          lrot = 1
     212        8640 :          DO i = 1, 3
     213     4394556 :             norm = SQRT(DOT_PRODUCT(Rot(:, i), Rot(:, i)))
     214        6480 :             IF (norm <= SQRT(thrs_motion)) THEN
     215         226 :                lrot(i) = 0
     216         226 :                CYCLE
     217             :             END IF
     218     4393010 :             Rot(:, i) = Rot(:, i)/norm
     219             :             ! Clean Rotational modes for spurious/numerical contamination
     220        8414 :             IF (i < 3) THEN
     221       10360 :                DO j = 1, i
     222     8783872 :                   Rot(:, i + 1) = Rot(:, i + 1) - DOT_PRODUCT(Rot(:, i + 1), Rot(:, j))*Rot(:, j)
     223             :                END DO
     224             :             END IF
     225             :          END DO
     226             :       END IF
     227        7520 :       IF (PRESENT(rot_dof)) rot_dof = COUNT(lrot == 1)
     228        8648 :       dof = dof + COUNT(lrot == 1)
     229        2162 :       iw = cp_print_key_unit_nr(logger, print_section, "ROTATIONAL_INFO", extension=".vibLog")
     230        2162 :       IF (iw > 0) THEN
     231         989 :          WRITE (iw, '(T2,A,T71,I10)') 'ROT| Number of rotovibrational vectors', dof
     232         989 :          IF (dof == 5) THEN
     233             :             WRITE (iw, '(T2,A)') &
     234          92 :                'ROT| Linear molecule detected'
     235             :          END IF
     236         989 :          IF ((dof == 3) .AND. (.NOT. keep_rotations)) THEN
     237             :             WRITE (iw, '(T2,A)') &
     238           6 :                'ROT| Single atom detected'
     239             :          END IF
     240             :       END IF
     241        2162 :       CALL cp_print_key_finished_output(iw, logger, print_section, "ROTATIONAL_INFO")
     242        2162 :       IF (present_mat) THEN
     243             :          ! Give back the vectors generating the rototranslating Frame
     244        1504 :          ALLOCATE (mat(natoms*3, dof))
     245         376 :          iseq = 0
     246        1504 :          DO i = 1, 3
     247       17310 :             mat(:, i) = Tr(:, i)
     248        1504 :             IF (lrot(i) == 1) THEN
     249        1072 :                iseq = iseq + 1
     250       16900 :                mat(:, 3 + iseq) = Rot(:, i)
     251             :             END IF
     252             :          END DO
     253             :       END IF
     254        2162 :       DEALLOCATE (Tr)
     255        2162 :       DEALLOCATE (Rot)
     256        2162 :       CALL timestop(handle)
     257             : 
     258        2162 :    END SUBROUTINE rot_ana
     259             : 
     260             : ! **************************************************************************************************
     261             : !> \brief   Prints the information controlled by the TRAJECTORY section
     262             : !> \param force_env ...
     263             : !> \param root_section ...
     264             : !> \param it ...
     265             : !> \param time ...
     266             : !> \param dtime ...
     267             : !> \param etot ...
     268             : !> \param pk_name ...
     269             : !> \param pos ...
     270             : !> \param act ...
     271             : !> \param middle_name ...
     272             : !> \param particles ...
     273             : !> \param extended_xmol_title ...
     274             : !> \date    02.2008
     275             : !> \author  Teodoro Laino [tlaino] - University of Zurich
     276             : !> \version 1.0
     277             : ! **************************************************************************************************
     278      229420 :    SUBROUTINE write_trajectory(force_env, root_section, it, time, dtime, etot, pk_name, &
     279             :                                pos, act, middle_name, particles, extended_xmol_title)
     280             :       TYPE(force_env_type), POINTER                      :: force_env
     281             :       TYPE(section_vals_type), POINTER                   :: root_section
     282             :       INTEGER, INTENT(IN)                                :: it
     283             :       REAL(KIND=dp), INTENT(IN)                          :: time, dtime, etot
     284             :       CHARACTER(LEN=*), OPTIONAL                         :: pk_name
     285             :       CHARACTER(LEN=default_string_length), OPTIONAL     :: pos, act
     286             :       CHARACTER(LEN=*), OPTIONAL                         :: middle_name
     287             :       TYPE(particle_list_type), OPTIONAL, POINTER        :: particles
     288             :       LOGICAL, INTENT(IN), OPTIONAL                      :: extended_xmol_title
     289             : 
     290             :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'write_trajectory'
     291             : 
     292             :       CHARACTER(LEN=4)                                   :: id_dcd
     293             :       CHARACTER(LEN=default_string_length)               :: id_label, id_wpc, my_act, my_ext, &
     294             :                                                             my_form, my_middle, my_pk_name, &
     295             :                                                             my_pos, remark1, remark2, section_ref, &
     296             :                                                             title, unit_str
     297             :       INTEGER                                            :: handle, i, ii, iskip, nat, outformat, &
     298             :                                                             traj_unit
     299      229420 :       INTEGER, POINTER                                   :: force_mixing_indices(:), &
     300      229420 :                                                             force_mixing_labels(:)
     301             :       LOGICAL                                            :: charge_beta, charge_extended, &
     302             :                                                             charge_occup, explicit, &
     303             :                                                             my_extended_xmol_title, new_file, &
     304             :                                                             print_kind
     305      229420 :       REAL(dp), ALLOCATABLE                              :: fml_array(:)
     306             :       REAL(KIND=dp)                                      :: unit_conv
     307             :       TYPE(cell_type), POINTER                           :: cell
     308             :       TYPE(cp_logger_type), POINTER                      :: logger
     309             :       TYPE(cp_subsys_type), POINTER                      :: subsys
     310             :       TYPE(particle_list_type), POINTER                  :: my_particles
     311      229420 :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
     312             :       TYPE(section_vals_type), POINTER                   :: force_env_section, &
     313             :                                                             force_mixing_restart_section
     314             : 
     315      229420 :       CALL timeset(routineN, handle)
     316             : 
     317      229420 :       NULLIFY (logger, cell, subsys, my_particles, particle_set)
     318      229420 :       logger => cp_get_default_logger()
     319      229420 :       id_label = logger%iter_info%level_name(logger%iter_info%n_rlevel)
     320      229420 :       my_pos = "APPEND"
     321      229420 :       my_act = "WRITE"
     322      229420 :       my_middle = "pos"
     323      229420 :       my_pk_name = "TRAJECTORY"
     324      229420 :       IF (PRESENT(middle_name)) my_middle = middle_name
     325      229420 :       IF (PRESENT(pos)) my_pos = pos
     326      229420 :       IF (PRESENT(act)) my_act = act
     327      229420 :       IF (PRESENT(pk_name)) my_pk_name = pk_name
     328             : 
     329      298637 :       SELECT CASE (TRIM(my_pk_name))
     330             :       CASE ("TRAJECTORY", "SHELL_TRAJECTORY", "CORE_TRAJECTORY")
     331       69217 :          id_dcd = "CORD"
     332       69217 :          id_wpc = "POS"
     333             :       CASE ("VELOCITIES", "SHELL_VELOCITIES", "CORE_VELOCITIES")
     334       47879 :          id_dcd = "VEL "
     335       47879 :          id_wpc = "VEL"
     336             :       CASE ("FORCES", "SHELL_FORCES", "CORE_FORCES")
     337       69217 :          id_dcd = "FRC "
     338       69217 :          id_wpc = "FORCE"
     339             :       CASE ("FORCE_MIXING_LABELS")
     340       43107 :          id_dcd = "FML "
     341       43107 :          id_wpc = "FORCE_MIXING_LABELS"
     342             :       CASE DEFAULT
     343      229420 :          CPABORT("")
     344             :       END SELECT
     345             : 
     346      229420 :       charge_occup = .FALSE.
     347      229420 :       charge_beta = .FALSE.
     348      229420 :       charge_extended = .FALSE.
     349      229420 :       print_kind = .FALSE.
     350             : 
     351      229420 :       CALL force_env_get(force_env, cell=cell, subsys=subsys)
     352      229420 :       IF (PRESENT(particles)) THEN
     353       30740 :          CPASSERT(ASSOCIATED(particles))
     354       30740 :          my_particles => particles
     355             :       ELSE
     356      198680 :          CALL cp_subsys_get(subsys=subsys, particles=my_particles)
     357             :       END IF
     358      229420 :       particle_set => my_particles%els
     359      229420 :       nat = my_particles%n_els
     360             : 
     361             :       ! Gather units of measure for output (if available)
     362      229420 :       IF (TRIM(my_pk_name) /= "FORCE_MIXING_LABELS") THEN
     363             :          CALL section_vals_val_get(root_section, "MOTION%PRINT%"//TRIM(my_pk_name)//"%UNIT", &
     364      186313 :                                    c_val=unit_str)
     365      186313 :          unit_conv = cp_unit_from_cp2k(1.0_dp, TRIM(unit_str))
     366             :       END IF
     367             : 
     368             :       ! Get the output format
     369      229420 :       CALL get_output_format(root_section, "MOTION%PRINT%"//TRIM(my_pk_name), my_form, my_ext)
     370             :       traj_unit = cp_print_key_unit_nr(logger, root_section, "MOTION%PRINT%"//TRIM(my_pk_name), &
     371             :                                        extension=my_ext, file_position=my_pos, file_action=my_act, &
     372      229420 :                                        file_form=my_form, middle_name=TRIM(my_middle), is_new_file=new_file)
     373      229420 :       IF (traj_unit > 0) THEN
     374             :          CALL section_vals_val_get(root_section, "MOTION%PRINT%"//TRIM(my_pk_name)//"%FORMAT", &
     375       22785 :                                    i_val=outformat)
     376       22785 :          title = ""
     377           4 :          SELECT CASE (outformat)
     378             :          CASE (dump_dcd, dump_dcd_aligned_cell)
     379           4 :             IF (new_file) THEN
     380             :                !Lets write the header for the coordinate dcd
     381           1 :                section_ref = "MOTION%PRINT%"//TRIM(my_pk_name)//"%EACH%"//TRIM(id_label)
     382           1 :                iskip = section_get_ival(root_section, TRIM(section_ref))
     383           1 :                WRITE (UNIT=traj_unit) id_dcd, 0, it, iskip, 0, 0, 0, 0, 0, 0, REAL(dtime, KIND=sp), &
     384           2 :                   1, 0, 0, 0, 0, 0, 0, 0, 0, 24
     385             :                remark1 = "REMARK "//id_dcd//" DCD file created by "//TRIM(cp2k_version)// &
     386           1 :                          " (revision "//TRIM(compile_revision)//")"
     387           1 :                remark2 = "REMARK "//TRIM(r_user_name)//"@"//TRIM(r_host_name)
     388           1 :                WRITE (UNIT=traj_unit) 2, remark1, remark2
     389           1 :                WRITE (UNIT=traj_unit) nat
     390           1 :                CALL m_flush(traj_unit)
     391             :             END IF
     392             :          CASE (dump_xmol)
     393       22712 :             my_extended_xmol_title = .FALSE.
     394             :             CALL section_vals_val_get(root_section, "MOTION%PRINT%TRAJECTORY%PRINT_ATOM_KIND", &
     395       22712 :                                       l_val=print_kind)
     396       22712 :             IF (PRESENT(extended_xmol_title)) my_extended_xmol_title = extended_xmol_title
     397             :             ! This information can be digested by Molden
     398       18405 :             IF (my_extended_xmol_title) THEN
     399             :                WRITE (UNIT=title, FMT="(A,I8,A,F12.3,A,F20.10)") &
     400       18405 :                   " i = ", it, ", time = ", time, ", E = ", etot
     401             :             ELSE
     402        4307 :                WRITE (UNIT=title, FMT="(A,I8,A,F20.10)") " i = ", it, ", E = ", etot
     403             :             END IF
     404             :          CASE (dump_atomic)
     405             :             ! Do nothing
     406             :          CASE (dump_pdb)
     407          59 :             IF (id_wpc == "POS") THEN
     408             :                CALL section_vals_val_get(root_section, "MOTION%PRINT%TRAJECTORY%CHARGE_OCCUP", &
     409          59 :                                          l_val=charge_occup)
     410             :                CALL section_vals_val_get(root_section, "MOTION%PRINT%TRAJECTORY%CHARGE_BETA", &
     411          59 :                                          l_val=charge_beta)
     412             :                CALL section_vals_val_get(root_section, "MOTION%PRINT%TRAJECTORY%CHARGE_EXTENDED", &
     413          59 :                                          l_val=charge_extended)
     414         236 :                i = COUNT((/charge_occup, charge_beta, charge_extended/))
     415          59 :                IF (i > 1) &
     416           0 :                   CPABORT("Either only CHARGE_OCCUP, CHARGE_BETA, or CHARGE_EXTENDED can be selected, ")
     417             :             END IF
     418          59 :             IF (new_file) THEN
     419             :                ! COLUMNS        DATA TYPE       FIELD          DEFINITION
     420             :                !  1 -  6        Record name     "TITLE "
     421             :                !  9 - 10        Continuation    continuation   Allows concatenation
     422             :                ! 11 - 70        String          title          Title of the experiment
     423             :                WRITE (UNIT=traj_unit, FMT="(A6,T11,A)") &
     424           4 :                   "TITLE ", "PDB file created by "//TRIM(cp2k_version)//" (revision "//TRIM(compile_revision)//")", &
     425           8 :                   "AUTHOR", TRIM(r_user_name)//"@"//TRIM(r_host_name)//" "//r_datx(1:19)
     426             :             END IF
     427          59 :             my_extended_xmol_title = .FALSE.
     428          59 :             IF (PRESENT(extended_xmol_title)) my_extended_xmol_title = extended_xmol_title
     429           0 :             IF (my_extended_xmol_title) THEN
     430             :                WRITE (UNIT=title, FMT="(A,I0,A,F0.3,A,F0.10)") &
     431           0 :                   "Step ", it, ", time = ", time, ", E = ", etot
     432             :             ELSE
     433             :                WRITE (UNIT=title, FMT="(A,I0,A,F0.10)") &
     434          59 :                   "Step ", it, ", E = ", etot
     435             :             END IF
     436             :          CASE DEFAULT
     437       22785 :             CPABORT("")
     438             :          END SELECT
     439       22785 :          IF (TRIM(my_pk_name) == "FORCE_MIXING_LABELS") THEN
     440         453 :             ALLOCATE (fml_array(3*SIZE(particle_set)))
     441       25978 :             fml_array = 0.0_dp
     442         151 :             CALL force_env_get(force_env, force_env_section=force_env_section)
     443             :             force_mixing_restart_section => section_vals_get_subs_vals(force_env_section, &
     444             :                                                                        "QMMM%FORCE_MIXING%RESTART_INFO", &
     445         151 :                                                                        can_return_null=.TRUE.)
     446         151 :             IF (ASSOCIATED(force_mixing_restart_section)) THEN
     447         151 :                CALL section_vals_get(force_mixing_restart_section, explicit=explicit)
     448         151 :                IF (explicit) THEN
     449           0 :                   CALL section_vals_val_get(force_mixing_restart_section, "INDICES", i_vals=force_mixing_indices)
     450           0 :                   CALL section_vals_val_get(force_mixing_restart_section, "LABELS", i_vals=force_mixing_labels)
     451           0 :                   DO i = 1, SIZE(force_mixing_indices)
     452           0 :                      ii = force_mixing_indices(i)
     453           0 :                      CPASSERT(ii <= SIZE(particle_set))
     454           0 :                      fml_array((ii - 1)*3 + 1:(ii - 1)*3 + 3) = force_mixing_labels(i)
     455             :                   END DO
     456             :                END IF
     457             :             END IF
     458             :             CALL write_particle_coordinates(particle_set, traj_unit, outformat, TRIM(id_wpc), TRIM(title), cell, &
     459         151 :                                             array=fml_array, print_kind=print_kind)
     460         151 :             DEALLOCATE (fml_array)
     461             :          ELSE
     462             :             CALL write_particle_coordinates(particle_set, traj_unit, outformat, TRIM(id_wpc), TRIM(title), cell, &
     463             :                                             unit_conv=unit_conv, print_kind=print_kind, &
     464             :                                             charge_occup=charge_occup, &
     465             :                                             charge_beta=charge_beta, &
     466       22634 :                                             charge_extended=charge_extended)
     467             :          END IF
     468             :       END IF
     469             : 
     470      229420 :       CALL cp_print_key_finished_output(traj_unit, logger, root_section, "MOTION%PRINT%"//TRIM(my_pk_name))
     471             : 
     472      229420 :       CALL timestop(handle)
     473             : 
     474      458840 :    END SUBROUTINE write_trajectory
     475             : 
     476             : ! **************************************************************************************************
     477             : !> \brief Info on the unit to be opened to dump MD informations
     478             : !> \param section ...
     479             : !> \param path ...
     480             : !> \param my_form ...
     481             : !> \param my_ext ...
     482             : !> \author Teodoro Laino - University of Zurich - 07.2007
     483             : ! **************************************************************************************************
     484      229446 :    SUBROUTINE get_output_format(section, path, my_form, my_ext)
     485             : 
     486             :       TYPE(section_vals_type), POINTER                   :: section
     487             :       CHARACTER(LEN=*), INTENT(IN), OPTIONAL             :: path
     488             :       CHARACTER(LEN=*), INTENT(OUT)                      :: my_form, my_ext
     489             : 
     490             :       INTEGER                                            :: output_format
     491             : 
     492      229472 :       IF (PRESENT(path)) THEN
     493      229420 :          CALL section_vals_val_get(section, TRIM(path)//"%FORMAT", i_val=output_format)
     494             :       ELSE
     495          26 :          CALL section_vals_val_get(section, "FORMAT", i_val=output_format)
     496             :       END IF
     497             : 
     498          14 :       SELECT CASE (output_format)
     499             :       CASE (dump_dcd, dump_dcd_aligned_cell)
     500          14 :          my_form = "UNFORMATTED"
     501          14 :          my_ext = ".dcd"
     502             :       CASE (dump_pdb)
     503         118 :          my_form = "FORMATTED"
     504         118 :          my_ext = ".pdb"
     505             :       CASE DEFAULT
     506      229314 :          my_form = "FORMATTED"
     507      458760 :          my_ext = ".xyz"
     508             :       END SELECT
     509             : 
     510      229446 :    END SUBROUTINE get_output_format
     511             : 
     512             : ! **************************************************************************************************
     513             : !> \brief   Prints the Stress Tensor
     514             : !> \param virial ...
     515             : !> \param cell ...
     516             : !> \param motion_section ...
     517             : !> \param itimes ...
     518             : !> \param time ...
     519             : !> \param pos ...
     520             : !> \param act ...
     521             : !> \date    02.2008
     522             : !> \author  Teodoro Laino [tlaino] - University of Zurich
     523             : !> \version 1.0
     524             : ! **************************************************************************************************
     525       55842 :    SUBROUTINE write_stress_tensor_to_file(virial, cell, motion_section, itimes, time, pos, act)
     526             : 
     527             :       TYPE(virial_type), POINTER                         :: virial
     528             :       TYPE(cell_type), POINTER                           :: cell
     529             :       TYPE(section_vals_type), POINTER                   :: motion_section
     530             :       INTEGER, INTENT(IN)                                :: itimes
     531             :       REAL(KIND=dp), INTENT(IN)                          :: time
     532             :       CHARACTER(LEN=default_string_length), INTENT(IN), &
     533             :          OPTIONAL                                        :: pos, act
     534             : 
     535             :       CHARACTER(LEN=default_string_length)               :: my_act, my_pos
     536             :       INTEGER                                            :: output_unit
     537             :       LOGICAL                                            :: new_file
     538             :       REAL(KIND=dp), DIMENSION(3, 3)                     :: pv_total_bar
     539             :       TYPE(cp_logger_type), POINTER                      :: logger
     540             : 
     541       55842 :       NULLIFY (logger)
     542       55842 :       logger => cp_get_default_logger()
     543             : 
     544       55842 :       IF (virial%pv_availability) THEN
     545       13220 :          my_pos = "APPEND"
     546       13220 :          my_act = "WRITE"
     547       13220 :          IF (PRESENT(pos)) my_pos = pos
     548       13220 :          IF (PRESENT(act)) my_act = act
     549             :          output_unit = cp_print_key_unit_nr(logger, motion_section, "PRINT%STRESS", &
     550             :                                             extension=".stress", file_position=my_pos, &
     551             :                                             file_action=my_act, file_form="FORMATTED", &
     552       13220 :                                             is_new_file=new_file)
     553             :       ELSE
     554       42622 :          output_unit = 0
     555             :       END IF
     556             : 
     557       55842 :       IF (output_unit > 0) THEN
     558        1482 :          IF (new_file) THEN
     559             :             WRITE (UNIT=output_unit, FMT='(A,9(12X,A2," [bar]"),6X,A)') &
     560          74 :                "#   Step   Time [fs]", "xx", "xy", "xz", "yx", "yy", "yz", "zx", "zy", "zz"
     561             :          END IF
     562        1482 :          pv_total_bar(1, 1) = cp_unit_from_cp2k(virial%pv_total(1, 1)/cell%deth, "bar")
     563        1482 :          pv_total_bar(1, 2) = cp_unit_from_cp2k(virial%pv_total(1, 2)/cell%deth, "bar")
     564        1482 :          pv_total_bar(1, 3) = cp_unit_from_cp2k(virial%pv_total(1, 3)/cell%deth, "bar")
     565        1482 :          pv_total_bar(2, 1) = cp_unit_from_cp2k(virial%pv_total(2, 1)/cell%deth, "bar")
     566        1482 :          pv_total_bar(2, 2) = cp_unit_from_cp2k(virial%pv_total(2, 2)/cell%deth, "bar")
     567        1482 :          pv_total_bar(2, 3) = cp_unit_from_cp2k(virial%pv_total(2, 3)/cell%deth, "bar")
     568        1482 :          pv_total_bar(3, 1) = cp_unit_from_cp2k(virial%pv_total(3, 1)/cell%deth, "bar")
     569        1482 :          pv_total_bar(3, 2) = cp_unit_from_cp2k(virial%pv_total(3, 2)/cell%deth, "bar")
     570        1482 :          pv_total_bar(3, 3) = cp_unit_from_cp2k(virial%pv_total(3, 3)/cell%deth, "bar")
     571        1482 :          WRITE (UNIT=output_unit, FMT='(I8,F12.3,9(1X,F19.10))') itimes, time, &
     572        1482 :             pv_total_bar(1, 1), pv_total_bar(1, 2), pv_total_bar(1, 3), &
     573        1482 :             pv_total_bar(2, 1), pv_total_bar(2, 2), pv_total_bar(2, 3), &
     574        2964 :             pv_total_bar(3, 1), pv_total_bar(3, 2), pv_total_bar(3, 3)
     575        1482 :          CALL m_flush(output_unit)
     576             :       END IF
     577             : 
     578       55842 :       IF (virial%pv_availability) THEN
     579             :          CALL cp_print_key_finished_output(output_unit, logger, motion_section, &
     580       13220 :                                            "PRINT%STRESS")
     581             :       END IF
     582             : 
     583       55842 :    END SUBROUTINE write_stress_tensor_to_file
     584             : 
     585             : ! **************************************************************************************************
     586             : !> \brief   Prints the Simulation Cell
     587             : !> \param cell ...
     588             : !> \param motion_section ...
     589             : !> \param itimes ...
     590             : !> \param time ...
     591             : !> \param pos ...
     592             : !> \param act ...
     593             : !> \date    02.2008
     594             : !> \author  Teodoro Laino [tlaino] - University of Zurich
     595             : !> \version 1.0
     596             : ! **************************************************************************************************
     597       55842 :    SUBROUTINE write_simulation_cell(cell, motion_section, itimes, time, pos, act)
     598             : 
     599             :       TYPE(cell_type), POINTER                           :: cell
     600             :       TYPE(section_vals_type), POINTER                   :: motion_section
     601             :       INTEGER, INTENT(IN)                                :: itimes
     602             :       REAL(KIND=dp), INTENT(IN)                          :: time
     603             :       CHARACTER(LEN=default_string_length), INTENT(IN), &
     604             :          OPTIONAL                                        :: pos, act
     605             : 
     606             :       CHARACTER(LEN=default_string_length)               :: my_act, my_pos
     607             :       INTEGER                                            :: output_unit
     608             :       LOGICAL                                            :: new_file
     609             :       TYPE(cp_logger_type), POINTER                      :: logger
     610             : 
     611       55842 :       NULLIFY (logger)
     612       55842 :       logger => cp_get_default_logger()
     613             : 
     614       55842 :       my_pos = "APPEND"
     615       55842 :       my_act = "WRITE"
     616       55842 :       IF (PRESENT(pos)) my_pos = pos
     617       55842 :       IF (PRESENT(act)) my_act = act
     618             : 
     619             :       output_unit = cp_print_key_unit_nr(logger, motion_section, "PRINT%CELL", &
     620             :                                          extension=".cell", file_position=my_pos, &
     621             :                                          file_action=my_act, file_form="FORMATTED", &
     622       55842 :                                          is_new_file=new_file)
     623             : 
     624       55842 :       IF (output_unit > 0) THEN
     625        2236 :          IF (new_file) THEN
     626             :             WRITE (UNIT=output_unit, FMT='(A,9(7X,A2," [Angstrom]"),6X,A)') &
     627         106 :                "#   Step   Time [fs]", "Ax", "Ay", "Az", "Bx", "By", "Bz", "Cx", "Cy", "Cz", &
     628         212 :                "Volume [Angstrom^3]"
     629             :          END IF
     630        2236 :          WRITE (UNIT=output_unit, FMT="(I8,F12.3,9(1X,F19.10),1X,F24.10)") itimes, time, &
     631        2236 :             cell%hmat(1, 1)*angstrom, cell%hmat(2, 1)*angstrom, cell%hmat(3, 1)*angstrom, &
     632        2236 :             cell%hmat(1, 2)*angstrom, cell%hmat(2, 2)*angstrom, cell%hmat(3, 2)*angstrom, &
     633        2236 :             cell%hmat(1, 3)*angstrom, cell%hmat(2, 3)*angstrom, cell%hmat(3, 3)*angstrom, &
     634        4472 :             cell%deth*angstrom*angstrom*angstrom
     635        2236 :          CALL m_flush(output_unit)
     636             :       END IF
     637             : 
     638             :       CALL cp_print_key_finished_output(output_unit, logger, motion_section, &
     639       55842 :                                         "PRINT%CELL")
     640             : 
     641       55842 :    END SUBROUTINE write_simulation_cell
     642             : 
     643             : END MODULE motion_utils

Generated by: LCOV version 1.15