Home
last modified time | relevance | path

Searched refs:r_shake (Results 1 – 10 of 10) sorted by relevance

/dports/science/cp2k/cp2k-2e995eec7fd208c8a72d9544807bd8b8ba8cd1cc/src/
H A Dconstraint_3x3.F99 SUBROUTINE shake_roll_3x3_int(molecule, particle_set, pos, vel, r_shake, & argument
105 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: r_shake, v_shake local
249 SUBROUTINE shake_roll_3x3_ext(gci, particle_set, pos, vel, r_shake, & argument
255 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: r_shake, v_shake local
524 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: r_shake, v_shake local
567 CALL matvec_3x3(f_roll1, r_shake, lg3x3(iconst)%fa)
568 CALL matvec_3x3(f_roll2, r_shake, lg3x3(iconst)%fb)
569 CALL matvec_3x3(f_roll3, r_shake, lg3x3(iconst)%fc)
635 CALL MATVEC_3x3(vec, r_shake, fc1)
637 CALL MATVEC_3x3(vec, r_shake, fc2)
[all …]
H A Dconstraint_clv.F188 SUBROUTINE shake_roll_colv_int(molecule, particle_set, pos, vel, r_shake, v_shake, & argument
194 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: r_shake, v_shake local
212 particle_set, pos, vel, r_shake, v_shake, dt, ishake, cell, &
393 SUBROUTINE shake_roll_colv_ext(gci, particle_set, pos, vel, r_shake, v_shake, & argument
399 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: r_shake, v_shake local
415 particle_set, pos, vel, r_shake, v_shake, dt, ishake, cell, &
716 particle_set, pos, vel, r_shake, v_shake, dt, ishake, cell, & argument
724 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: r_shake, v_shake local
742 roll=.TRUE., rmat=r_shake, imass=imass)
757 lcolv(iconst)%colvar_old, roll=.TRUE., rmat=r_shake, &
[all …]
H A Dconstraint.F368 REAL(KIND=dp), DIMENSION(3, 3) :: r_shake, v_shake local
383 CALL get_roll_matrix('SHAKE', r_shake, v_shake, vector_r, vector_v)
385 CALL get_roll_matrix('SHAKE', r_shake, v_shake, vector_r, vector_v, u)
416 CALL shake_roll_3x3_int(molecule, particle_set, pos, vel, r_shake, &
420 CALL shake_roll_4x6_int(molecule, particle_set, pos, vel, r_shake, &
424 CALL shake_roll_colv_int(molecule, particle_set, pos, vel, r_shake, &
440 CALL shake_roll_3x3_ext(gci, particle_set, pos, vel, r_shake, &
444 CALL shake_roll_4x6_ext(gci, particle_set, pos, vel, r_shake, &
448 CALL shake_roll_colv_ext(gci, particle_set, pos, vel, r_shake, &
459 CALL check_tol(roll_tol, iroll, 'SHAKE', r_shake)
H A Dconstraint_4x6.F682 CALL matvec_3x3(f_roll1, r_shake, lg4x6(iconst)%fa)
683 CALL matvec_3x3(f_roll2, r_shake, lg4x6(iconst)%fb)
684 CALL matvec_3x3(f_roll3, r_shake, lg4x6(iconst)%fc)
837 CALL MATVEC_3x3(vec, r_shake, fc1)
839 CALL MATVEC_3x3(vec, r_shake, fc2)
841 CALL MATVEC_3x3(vec, r_shake, fc3)
843 CALL MATVEC_3x3(vec, r_shake, fc4)
845 CALL MATVEC_3x3(vec, r_shake, fc1)
847 CALL MATVEC_3x3(vec, r_shake, fc2)
849 CALL MATVEC_3x3(vec, r_shake, fc3)
[all …]
H A Dconstraint_util.F537 SUBROUTINE get_roll_matrix(char, r_shake, v_shake, vector_r, vector_v, u) argument
541 OPTIONAL :: r_shake, v_shake local
552 IF (PRESENT(r_shake)) r_shake = 0.0_dp
563 r_shake = MATMUL_3X3(MATMUL_3X3(u, diag), TRANSPOSE_3D(u))
568 diag = MATMUL_3x3(r_shake, v_shake)
569 r_shake = diag
573 r_shake(i, i) = vector_r(i)*vector_v(i)
/dports/science/cp2k-data/cp2k-7.1.0/src/
H A Dconstraint_3x3.F99 SUBROUTINE shake_roll_3x3_int(molecule, particle_set, pos, vel, r_shake, & argument
105 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: r_shake, v_shake local
249 SUBROUTINE shake_roll_3x3_ext(gci, particle_set, pos, vel, r_shake, & argument
255 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: r_shake, v_shake local
524 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: r_shake, v_shake local
567 CALL matvec_3x3(f_roll1, r_shake, lg3x3(iconst)%fa)
568 CALL matvec_3x3(f_roll2, r_shake, lg3x3(iconst)%fb)
569 CALL matvec_3x3(f_roll3, r_shake, lg3x3(iconst)%fc)
635 CALL MATVEC_3x3(vec, r_shake, fc1)
637 CALL MATVEC_3x3(vec, r_shake, fc2)
[all …]
H A Dconstraint_clv.F188 SUBROUTINE shake_roll_colv_int(molecule, particle_set, pos, vel, r_shake, v_shake, & argument
194 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: r_shake, v_shake local
212 particle_set, pos, vel, r_shake, v_shake, dt, ishake, cell, &
393 SUBROUTINE shake_roll_colv_ext(gci, particle_set, pos, vel, r_shake, v_shake, & argument
399 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: r_shake, v_shake local
415 particle_set, pos, vel, r_shake, v_shake, dt, ishake, cell, &
716 particle_set, pos, vel, r_shake, v_shake, dt, ishake, cell, & argument
724 REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: r_shake, v_shake local
742 roll=.TRUE., rmat=r_shake, imass=imass)
757 lcolv(iconst)%colvar_old, roll=.TRUE., rmat=r_shake, &
[all …]
H A Dconstraint.F368 REAL(KIND=dp), DIMENSION(3, 3) :: r_shake, v_shake local
383 CALL get_roll_matrix('SHAKE', r_shake, v_shake, vector_r, vector_v)
385 CALL get_roll_matrix('SHAKE', r_shake, v_shake, vector_r, vector_v, u)
416 CALL shake_roll_3x3_int(molecule, particle_set, pos, vel, r_shake, &
420 CALL shake_roll_4x6_int(molecule, particle_set, pos, vel, r_shake, &
424 CALL shake_roll_colv_int(molecule, particle_set, pos, vel, r_shake, &
440 CALL shake_roll_3x3_ext(gci, particle_set, pos, vel, r_shake, &
444 CALL shake_roll_4x6_ext(gci, particle_set, pos, vel, r_shake, &
448 CALL shake_roll_colv_ext(gci, particle_set, pos, vel, r_shake, &
459 CALL check_tol(roll_tol, iroll, 'SHAKE', r_shake)
H A Dconstraint_4x6.F682 CALL matvec_3x3(f_roll1, r_shake, lg4x6(iconst)%fa)
683 CALL matvec_3x3(f_roll2, r_shake, lg4x6(iconst)%fb)
684 CALL matvec_3x3(f_roll3, r_shake, lg4x6(iconst)%fc)
837 CALL MATVEC_3x3(vec, r_shake, fc1)
839 CALL MATVEC_3x3(vec, r_shake, fc2)
841 CALL MATVEC_3x3(vec, r_shake, fc3)
843 CALL MATVEC_3x3(vec, r_shake, fc4)
845 CALL MATVEC_3x3(vec, r_shake, fc1)
847 CALL MATVEC_3x3(vec, r_shake, fc2)
849 CALL MATVEC_3x3(vec, r_shake, fc3)
[all …]
H A Dconstraint_util.F537 SUBROUTINE get_roll_matrix(char, r_shake, v_shake, vector_r, vector_v, u) argument
541 OPTIONAL :: r_shake, v_shake local
552 IF (PRESENT(r_shake)) r_shake = 0.0_dp
563 r_shake = MATMUL_3X3(MATMUL_3X3(u, diag), TRANSPOSE_3D(u))
568 diag = MATMUL_3x3(r_shake, v_shake)
569 r_shake = diag
573 r_shake(i, i) = vector_r(i)*vector_v(i)