Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
fixed version of check
svn-origin-rev: 13196
  • Loading branch information
tlaino committed Oct 7, 2013
1 parent c03aeb4 commit 82b8204
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 8 deletions.
24 changes: 18 additions & 6 deletions src/force_env_methods.F
Expand Up @@ -950,8 +950,7 @@ RECURSIVE SUBROUTINE qmmm_energy_and_forces(force_env,calc_force,require_consist
error,failure)
ENDIF
! Possibly translate the system
! Possibly translate the system
CALL apply_qmmm_translate(force_env, error)
DO isubf=1, SIZE(force_env%sub_force_env)
Expand Down Expand Up @@ -1095,11 +1094,11 @@ RECURSIVE SUBROUTINE qmmm_energy_and_forces_low(force_env,calc_force,error)
routineP = moduleN//':'//routineN
CHARACTER(LEN=default_string_length) :: description, iter
INTEGER :: ip, nres, output_unit
INTEGER :: ip, j, nres, output_unit
INTEGER, DIMENSION(:), POINTER :: qm_atom_index
LOGICAL :: calculate_forces, failure, &
qmmm_added_chrg, qmmm_link, &
qmmm_link_imomm
LOGICAL :: calculate_forces, check, &
failure, qmmm_added_chrg, &
qmmm_link, qmmm_link_imomm
REAL(KIND=dp) :: energy_mm, energy_qm
REAL(KIND=dp), DIMENSION(3) :: dip_mm, dip_qm, dip_qmmm, &
max_coord, min_coord
Expand Down Expand Up @@ -1147,6 +1146,19 @@ RECURSIVE SUBROUTINE qmmm_energy_and_forces_low(force_env,calc_force,error)
particles_mm => subsys_mm%particles%els
particles_qm => subsys_qm%particles%els
DO j=1,3
IF (qm_cell%perd(j)==1) CYCLE
DO ip=1, SIZE(particles_qm)
check = (DOT_PRODUCT(qm_cell%h_inv(j,:),particles_qm(ip)%r) >= 0.0) .AND. &
(DOT_PRODUCT(qm_cell%h_inv(j,:),particles_qm(ip)%r) <= 1.0)
CALL cp_assert(check, cp_failure_level, cp_assertion_failed, routinep,&
"QM/MM QM atoms must be fully contained in the same image of the QM box "//&
"- No wrapping of coordinates is allowed! "//&
CPSourceFileRef,&
error)
END DO
END DO
! If present QM/MM links (just IMOMM) correct the position of the qm-link atom
IF (qmmm_link_imomm) CALL qmmm_link_Imomm_coord(qmmm_links, particles_qm, qm_atom_index, error)
Expand Down
5 changes: 3 additions & 2 deletions src/qs_scf.F
Expand Up @@ -242,8 +242,9 @@ SUBROUTINE scf_env_do_scf(scf_env,qs_env,converged,should_stop,error)
INTEGER :: ext_master_id, external_comm, handle, handle2, ispin, &
iter_count, output_unit, scf_energy_message_tag, total_steps
LOGICAL :: diis_step, energy_only, exit_inner_loop, exit_outer_loop, &
failure, gapw, gapw_xc, harris_flag, has_unit_metric, just_energy, &
inner_loop_converged, outer_loop_converged, scp_nddo, use_jacobi
failure, gapw, gapw_xc, harris_flag, has_unit_metric, &
inner_loop_converged, just_energy, outer_loop_converged, scp_nddo, &
use_jacobi
REAL(KIND=dp) :: t1, t2
TYPE(atomic_kind_type), DIMENSION(:), &
POINTER :: atomic_kind_set
Expand Down

0 comments on commit 82b8204

Please sign in to comment.