20 g3x3_constraint_type,&
24 global_constraint_type,&
25 local_g3x3_constraint_type,&
28 #include "./base/base_uses.f90"
42 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'constraint_3x3'
58 SUBROUTINE shake_3x3_int(molecule, particle_set, pos, vel, dt, ishake, &
61 TYPE(molecule_type),
POINTER :: molecule
62 TYPE(particle_type),
POINTER :: particle_set(:)
63 REAL(kind=
dp),
INTENT(INOUT) :: pos(:, :), vel(:, :)
64 REAL(kind=
dp),
INTENT(in) :: dt
65 INTEGER,
INTENT(IN) :: ishake
66 REAL(kind=
dp),
INTENT(INOUT) :: max_sigma
68 INTEGER :: first_atom, ng3x3
69 TYPE(fixd_constraint_type),
DIMENSION(:),
POINTER :: fixd_list
70 TYPE(g3x3_constraint_type),
POINTER :: g3x3_list(:)
71 TYPE(local_g3x3_constraint_type),
POINTER :: lg3x3(:)
72 TYPE(molecule_kind_type),
POINTER :: molecule_kind
75 molecule_kind => molecule%molecule_kind
77 g3x3_list=g3x3_list, fixd_list=fixd_list)
78 CALL get_molecule(molecule, first_atom=first_atom, lg3x3=lg3x3)
80 CALL shake_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, ng3x3, &
81 particle_set, pos, vel, dt, ishake, max_sigma)
100 v_shake, dt, ishake, max_sigma)
102 TYPE(molecule_type),
POINTER :: molecule
103 TYPE(particle_type),
POINTER :: particle_set(:)
104 REAL(kind=
dp),
INTENT(INOUT) :: pos(:, :), vel(:, :)
105 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: r_shake, v_shake
106 REAL(kind=
dp),
INTENT(in) :: dt
107 INTEGER,
INTENT(IN) :: ishake
108 REAL(kind=
dp),
INTENT(INOUT) :: max_sigma
110 INTEGER :: first_atom, ng3x3
111 TYPE(fixd_constraint_type),
DIMENSION(:),
POINTER :: fixd_list
112 TYPE(g3x3_constraint_type),
POINTER :: g3x3_list(:)
113 TYPE(local_g3x3_constraint_type),
POINTER :: lg3x3(:)
114 TYPE(molecule_kind_type),
POINTER :: molecule_kind
117 molecule_kind => molecule%molecule_kind
119 g3x3_list=g3x3_list, fixd_list=fixd_list)
120 CALL get_molecule(molecule, first_atom=first_atom, lg3x3=lg3x3)
122 CALL shake_roll_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, ng3x3, &
123 particle_set, pos, vel, r_shake, v_shake, dt, ishake, max_sigma)
140 TYPE(molecule_type),
POINTER :: molecule
141 TYPE(particle_type),
POINTER :: particle_set(:)
142 REAL(kind=
dp),
INTENT(INOUT) :: vel(:, :)
143 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: r_rattle
144 REAL(kind=
dp),
INTENT(in) :: dt
145 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: veps
147 INTEGER :: first_atom
148 TYPE(fixd_constraint_type),
DIMENSION(:),
POINTER :: fixd_list
149 TYPE(g3x3_constraint_type),
POINTER :: g3x3_list(:)
150 TYPE(local_g3x3_constraint_type),
POINTER :: lg3x3(:)
151 TYPE(molecule_kind_type),
POINTER :: molecule_kind
154 molecule_kind => molecule%molecule_kind
156 g3x3_list=g3x3_list, fixd_list=fixd_list)
157 CALL get_molecule(molecule, first_atom=first_atom, lg3x3=lg3x3)
159 CALL rattle_roll_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, &
160 particle_set, vel, r_rattle, dt, veps)
175 TYPE(molecule_type),
POINTER :: molecule
176 TYPE(particle_type),
POINTER :: particle_set(:)
177 REAL(kind=
dp),
INTENT(INOUT) :: vel(:, :)
178 REAL(kind=
dp),
INTENT(in) :: dt
180 INTEGER :: first_atom
181 TYPE(fixd_constraint_type),
DIMENSION(:),
POINTER :: fixd_list
182 TYPE(g3x3_constraint_type),
POINTER :: g3x3_list(:)
183 TYPE(local_g3x3_constraint_type),
POINTER :: lg3x3(:)
184 TYPE(molecule_kind_type),
POINTER :: molecule_kind
187 molecule_kind => molecule%molecule_kind
189 g3x3_list=g3x3_list, fixd_list=fixd_list)
190 CALL get_molecule(molecule, first_atom=first_atom, lg3x3=lg3x3)
192 CALL rattle_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, &
193 particle_set, vel, dt)
212 TYPE(global_constraint_type),
POINTER :: gci
213 TYPE(particle_type),
POINTER :: particle_set(:)
214 REAL(kind=
dp),
INTENT(INOUT) :: pos(:, :), vel(:, :)
215 REAL(kind=
dp),
INTENT(in) :: dt
216 INTEGER,
INTENT(IN) :: ishake
217 REAL(kind=
dp),
INTENT(INOUT) :: max_sigma
219 INTEGER :: first_atom, ng3x3
220 TYPE(fixd_constraint_type),
DIMENSION(:),
POINTER :: fixd_list
221 TYPE(g3x3_constraint_type),
POINTER :: g3x3_list(:)
222 TYPE(local_g3x3_constraint_type),
POINTER :: lg3x3(:)
226 g3x3_list => gci%g3x3_list
227 fixd_list => gci%fixd_list
230 CALL shake_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, ng3x3, &
231 particle_set, pos, vel, dt, ishake, max_sigma)
250 v_shake, dt, ishake, max_sigma)
252 TYPE(global_constraint_type),
POINTER :: gci
253 TYPE(particle_type),
POINTER :: particle_set(:)
254 REAL(kind=
dp),
INTENT(INOUT) :: pos(:, :), vel(:, :)
255 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: r_shake, v_shake
256 REAL(kind=
dp),
INTENT(in) :: dt
257 INTEGER,
INTENT(IN) :: ishake
258 REAL(kind=
dp),
INTENT(INOUT) :: max_sigma
260 INTEGER :: first_atom, ng3x3
261 TYPE(fixd_constraint_type),
DIMENSION(:),
POINTER :: fixd_list
262 TYPE(g3x3_constraint_type),
POINTER :: g3x3_list(:)
263 TYPE(local_g3x3_constraint_type),
POINTER :: lg3x3(:)
267 g3x3_list => gci%g3x3_list
268 fixd_list => gci%fixd_list
271 CALL shake_roll_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, ng3x3, &
272 particle_set, pos, vel, r_shake, v_shake, dt, ishake, max_sigma)
289 TYPE(global_constraint_type),
POINTER :: gci
290 TYPE(particle_type),
POINTER :: particle_set(:)
291 REAL(kind=
dp),
INTENT(INOUT) :: vel(:, :)
292 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: r_rattle
293 REAL(kind=
dp),
INTENT(in) :: dt
294 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: veps
296 INTEGER :: first_atom
297 TYPE(fixd_constraint_type),
DIMENSION(:),
POINTER :: fixd_list
298 TYPE(g3x3_constraint_type),
POINTER :: g3x3_list(:)
299 TYPE(local_g3x3_constraint_type),
POINTER :: lg3x3(:)
302 g3x3_list => gci%g3x3_list
303 fixd_list => gci%fixd_list
306 CALL rattle_roll_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, &
307 particle_set, vel, r_rattle, dt, veps)
322 TYPE(global_constraint_type),
POINTER :: gci
323 TYPE(particle_type),
POINTER :: particle_set(:)
324 REAL(kind=
dp),
INTENT(INOUT) :: vel(:, :)
325 REAL(kind=
dp),
INTENT(in) :: dt
327 INTEGER :: first_atom
328 TYPE(fixd_constraint_type),
DIMENSION(:),
POINTER :: fixd_list
329 TYPE(g3x3_constraint_type),
POINTER :: g3x3_list(:)
330 TYPE(local_g3x3_constraint_type),
POINTER :: lg3x3(:)
333 g3x3_list => gci%g3x3_list
334 fixd_list => gci%fixd_list
337 CALL rattle_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, &
338 particle_set, vel, dt)
358 SUBROUTINE shake_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, ng3x3, &
359 particle_set, pos, vel, dt, ishake, max_sigma)
361 TYPE(fixd_constraint_type),
DIMENSION(:),
POINTER :: fixd_list
362 TYPE(g3x3_constraint_type),
POINTER :: g3x3_list(:)
363 TYPE(local_g3x3_constraint_type),
POINTER :: lg3x3(:)
364 INTEGER,
INTENT(IN) :: first_atom, ng3x3
365 TYPE(particle_type),
POINTER :: particle_set(:)
366 REAL(kind=
dp),
INTENT(INOUT) :: pos(:, :), vel(:, :)
367 REAL(kind=
dp),
INTENT(in) :: dt
368 INTEGER,
INTENT(IN) :: ishake
369 REAL(kind=
dp),
INTENT(INOUT) :: max_sigma
371 INTEGER :: iconst, index_a, index_b, index_c
372 REAL(kind=
dp) :: dtby2, dtsqby2, idtsq, imass1, imass2, &
374 REAL(kind=
dp),
DIMENSION(3) :: fc1, fc2, fc3, r0_12, r0_13, r0_23, r1, &
375 r12, r13, r2, r23, r3, v1, v2, v3, vec
376 REAL(kind=
dp),
DIMENSION(3, 1) :: bvec
377 REAL(kind=
dp),
DIMENSION(3, 3) :: amat, atemp
378 TYPE(atomic_kind_type),
POINTER :: atomic_kind
380 dtsqby2 = dt*dt*.5_dp
384 IF (g3x3_list(iconst)%restraint%active) cycle
385 index_a = g3x3_list(iconst)%a + first_atom - 1
386 index_b = g3x3_list(iconst)%b + first_atom - 1
387 index_c = g3x3_list(iconst)%c + first_atom - 1
388 IF (ishake == 1)
THEN
389 r0_12(:) = pos(:, index_a) - pos(:, index_b)
390 r0_13(:) = pos(:, index_a) - pos(:, index_c)
391 r0_23(:) = pos(:, index_b) - pos(:, index_c)
392 atomic_kind => particle_set(index_a)%atomic_kind
393 imass1 = 1.0_dp/atomic_kind%mass
394 atomic_kind => particle_set(index_b)%atomic_kind
395 imass2 = 1.0_dp/atomic_kind%mass
396 atomic_kind => particle_set(index_c)%atomic_kind
397 imass3 = 1.0_dp/atomic_kind%mass
398 lg3x3(iconst)%fa = -2.0_dp*(lg3x3(iconst)%ra_old - &
399 lg3x3(iconst)%rb_old)
400 lg3x3(iconst)%fb = -2.0_dp*(lg3x3(iconst)%ra_old - &
401 lg3x3(iconst)%rc_old)
402 lg3x3(iconst)%fc = -2.0_dp*(lg3x3(iconst)%rb_old - &
403 lg3x3(iconst)%rc_old)
406 index_a, index_b, index_c, fixd_list, lg3x3(iconst))
408 amat(1, 1) = (imass1 + imass2)*dot_product(r0_12, lg3x3(iconst)%fa)
409 amat(1, 2) = imass1*dot_product(r0_12, lg3x3(iconst)%fb)
410 amat(1, 3) = -imass2*dot_product(r0_12, lg3x3(iconst)%fc)
411 amat(2, 1) = imass1*dot_product(r0_13, lg3x3(iconst)%fa)
412 amat(2, 2) = (imass1 + imass3)*dot_product(r0_13, lg3x3(iconst)%fb)
413 amat(2, 3) = imass3*dot_product(r0_13, lg3x3(iconst)%fc)
414 amat(3, 1) = -imass2*dot_product(r0_23, lg3x3(iconst)%fa)
415 amat(3, 2) = imass3*dot_product(r0_23, lg3x3(iconst)%fb)
416 amat(3, 3) = (imass3 + imass2)*dot_product(r0_23, lg3x3(iconst)%fc)
418 lg3x3(iconst)%r0_12 = r0_12
419 lg3x3(iconst)%r0_13 = r0_13
420 lg3x3(iconst)%r0_23 = r0_23
421 lg3x3(iconst)%amat = amat
422 lg3x3(iconst)%lambda_old = 0.0_dp
423 lg3x3(iconst)%del_lambda = 0.0_dp
426 r0_12 = lg3x3(iconst)%r0_12
427 r0_13 = lg3x3(iconst)%r0_13
428 r0_23 = lg3x3(iconst)%r0_23
429 amat = lg3x3(iconst)%amat
430 imass1 = lg3x3(iconst)%imass1
431 imass2 = lg3x3(iconst)%imass2
432 imass3 = lg3x3(iconst)%imass3
435 vec = lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa*(imass1 + imass2) + &
436 lg3x3(iconst)%lambda(2)*imass1*lg3x3(iconst)%fb - &
437 lg3x3(iconst)%lambda(3)*imass2*lg3x3(iconst)%fc
438 bvec(1, 1) = g3x3_list(iconst)%dab*g3x3_list(iconst)%dab &
439 - dtsqby2*dtsqby2*dot_product(vec, vec) - dot_product(r0_12, r0_12)
440 vec = lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa*imass1 + &
441 lg3x3(iconst)%lambda(2)*(imass1 + imass3)*lg3x3(iconst)%fb + &
442 lg3x3(iconst)%lambda(3)*imass3*lg3x3(iconst)%fc
443 bvec(2, 1) = g3x3_list(iconst)%dac*g3x3_list(iconst)%dac &
444 - dtsqby2*dtsqby2*dot_product(vec, vec) - dot_product(r0_13, r0_13)
445 vec = -lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa*imass2 + &
446 lg3x3(iconst)%lambda(2)*imass3*lg3x3(iconst)%fb + &
447 lg3x3(iconst)%lambda(3)*(imass2 + imass3)*lg3x3(iconst)%fc
448 bvec(3, 1) = g3x3_list(iconst)%dbc*g3x3_list(iconst)%dbc &
449 - dtsqby2*dtsqby2*dot_product(vec, vec) - dot_product(r0_23, r0_23)
454 lg3x3(iconst)%lambda(:) = bvec(:, 1)
455 lg3x3(iconst)%del_lambda(:) = lg3x3(iconst)%lambda(:) - &
456 lg3x3(iconst)%lambda_old(:)
457 lg3x3(iconst)%lambda_old(:) = lg3x3(iconst)%lambda(:)
458 fc1 = lg3x3(iconst)%del_lambda(1)*lg3x3(iconst)%fa + &
459 lg3x3(iconst)%del_lambda(2)*lg3x3(iconst)%fb
460 fc2 = -lg3x3(iconst)%del_lambda(1)*lg3x3(iconst)%fa + &
461 lg3x3(iconst)%del_lambda(3)*lg3x3(iconst)%fc
462 fc3 = -lg3x3(iconst)%del_lambda(2)*lg3x3(iconst)%fb - &
463 lg3x3(iconst)%del_lambda(3)*lg3x3(iconst)%fc
464 r1(:) = pos(:, index_a) + imass1*dtsqby2*fc1(:)
465 r2(:) = pos(:, index_b) + imass2*dtsqby2*fc2(:)
466 r3(:) = pos(:, index_c) + imass3*dtsqby2*fc3(:)
467 v1(:) = vel(:, index_a) + imass1*dtby2*fc1(:)
468 v2(:) = vel(:, index_b) + imass2*dtby2*fc2(:)
469 v3(:) = vel(:, index_c) + imass3*dtby2*fc3(:)
475 sigma = dot_product(r12, r12) - g3x3_list(iconst)%dab* &
476 g3x3_list(iconst)%dab
477 max_sigma = max(max_sigma, abs(sigma))
478 sigma = dot_product(r13, r13) - g3x3_list(iconst)%dac* &
479 g3x3_list(iconst)%dac
480 max_sigma = max(max_sigma, abs(sigma))
481 sigma = dot_product(r23, r23) - g3x3_list(iconst)%dbc* &
482 g3x3_list(iconst)%dbc
483 max_sigma = max(max_sigma, abs(sigma))
485 pos(:, index_a) = r1(:)
486 pos(:, index_b) = r2(:)
487 pos(:, index_c) = r3(:)
490 vel(:, index_a) = v1(:)
491 vel(:, index_b) = v2(:)
492 vel(:, index_c) = v3(:)
495 END SUBROUTINE shake_3x3_low
515 SUBROUTINE shake_roll_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, ng3x3, &
516 particle_set, pos, vel, r_shake, v_shake, dt, ishake, max_sigma)
518 TYPE(fixd_constraint_type),
DIMENSION(:),
POINTER :: fixd_list
519 TYPE(g3x3_constraint_type),
POINTER :: g3x3_list(:)
520 TYPE(local_g3x3_constraint_type),
POINTER :: lg3x3(:)
521 INTEGER,
INTENT(IN) :: first_atom, ng3x3
522 TYPE(particle_type),
POINTER :: particle_set(:)
523 REAL(kind=
dp),
INTENT(INOUT) :: pos(:, :), vel(:, :)
524 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: r_shake, v_shake
525 REAL(kind=
dp),
INTENT(in) :: dt
526 INTEGER,
INTENT(IN) :: ishake
527 REAL(kind=
dp),
INTENT(INOUT) :: max_sigma
529 INTEGER :: iconst, index_a, index_b, index_c
530 REAL(kind=
dp) :: dtby2, dtsqby2, idtsq, imass1, imass2, &
532 REAL(kind=
dp),
DIMENSION(3) :: f_roll1, f_roll2, f_roll3, fc1, fc2, &
533 fc3, r0_12, r0_13, r0_23, r1, r12, &
534 r13, r2, r23, r3, v1, v2, v3, vec
535 REAL(kind=
dp),
DIMENSION(3, 1) :: bvec
536 REAL(kind=
dp),
DIMENSION(3, 3) :: amat, atemp
537 TYPE(atomic_kind_type),
POINTER :: atomic_kind
539 dtsqby2 = dt*dt*.5_dp
543 IF (g3x3_list(iconst)%restraint%active) cycle
544 index_a = g3x3_list(iconst)%a + first_atom - 1
545 index_b = g3x3_list(iconst)%b + first_atom - 1
546 index_c = g3x3_list(iconst)%c + first_atom - 1
547 IF (ishake == 1)
THEN
548 r0_12(:) = pos(:, index_a) - pos(:, index_b)
549 r0_13(:) = pos(:, index_a) - pos(:, index_c)
550 r0_23(:) = pos(:, index_b) - pos(:, index_c)
551 atomic_kind => particle_set(index_a)%atomic_kind
552 imass1 = 1.0_dp/atomic_kind%mass
553 atomic_kind => particle_set(index_b)%atomic_kind
554 imass2 = 1.0_dp/atomic_kind%mass
555 atomic_kind => particle_set(index_c)%atomic_kind
556 imass3 = 1.0_dp/atomic_kind%mass
557 lg3x3(iconst)%fa = -2.0_dp*(lg3x3(iconst)%ra_old - &
558 lg3x3(iconst)%rb_old)
559 lg3x3(iconst)%fb = -2.0_dp*(lg3x3(iconst)%ra_old - &
560 lg3x3(iconst)%rc_old)
561 lg3x3(iconst)%fc = -2.0_dp*(lg3x3(iconst)%rb_old - &
562 lg3x3(iconst)%rc_old)
565 index_a, index_b, index_c, fixd_list, lg3x3(iconst))
567 f_roll1 = matmul(r_shake, lg3x3(iconst)%fa)
568 f_roll2 = matmul(r_shake, lg3x3(iconst)%fb)
569 f_roll3 = matmul(r_shake, lg3x3(iconst)%fc)
571 amat(1, 1) = (imass1 + imass2)*dot_product(r0_12, f_roll1)
572 amat(1, 2) = imass1*dot_product(r0_12, f_roll2)
573 amat(1, 3) = -imass2*dot_product(r0_12, f_roll3)
574 amat(2, 1) = imass1*dot_product(r0_13, f_roll1)
575 amat(2, 2) = (imass1 + imass3)*dot_product(r0_13, f_roll2)
576 amat(2, 3) = imass3*dot_product(r0_13, f_roll3)
577 amat(3, 1) = -imass2*dot_product(r0_23, f_roll1)
578 amat(3, 2) = imass3*dot_product(r0_23, f_roll2)
579 amat(3, 3) = (imass3 + imass2)*dot_product(r0_23, f_roll3)
581 lg3x3(iconst)%r0_12 = r0_12
582 lg3x3(iconst)%r0_13 = r0_13
583 lg3x3(iconst)%r0_23 = r0_23
584 lg3x3(iconst)%f_roll1 = f_roll1
585 lg3x3(iconst)%f_roll2 = f_roll2
586 lg3x3(iconst)%f_roll3 = f_roll3
587 lg3x3(iconst)%amat = amat
588 lg3x3(iconst)%lambda_old = 0.0_dp
589 lg3x3(iconst)%del_lambda = 0.0_dp
592 r0_12 = lg3x3(iconst)%r0_12
593 r0_13 = lg3x3(iconst)%r0_13
594 r0_23 = lg3x3(iconst)%r0_23
595 f_roll1 = lg3x3(iconst)%f_roll1
596 f_roll2 = lg3x3(iconst)%f_roll2
597 f_roll3 = lg3x3(iconst)%f_roll3
598 amat = lg3x3(iconst)%amat
599 imass1 = lg3x3(iconst)%imass1
600 imass2 = lg3x3(iconst)%imass2
601 imass3 = lg3x3(iconst)%imass3
604 vec = lg3x3(iconst)%lambda(1)*f_roll1*(imass1 + imass2) + &
605 lg3x3(iconst)%lambda(2)*imass1*f_roll2 - &
606 lg3x3(iconst)%lambda(3)*imass2*f_roll3
607 bvec(1, 1) = g3x3_list(iconst)%dab*g3x3_list(iconst)%dab &
608 - dtsqby2*dtsqby2*dot_product(vec, vec) - dot_product(r0_12, r0_12)
609 vec = lg3x3(iconst)%lambda(1)*f_roll1*imass1 + &
610 lg3x3(iconst)%lambda(2)*(imass1 + imass3)*f_roll2 + &
611 lg3x3(iconst)%lambda(3)*imass3*f_roll3
612 bvec(2, 1) = g3x3_list(iconst)%dac*g3x3_list(iconst)%dac &
613 - dtsqby2*dtsqby2*dot_product(vec, vec) - dot_product(r0_13, r0_13)
614 vec = -lg3x3(iconst)%lambda(1)*f_roll1*imass2 + &
615 lg3x3(iconst)%lambda(2)*imass3*f_roll2 + &
616 lg3x3(iconst)%lambda(3)*(imass2 + imass3)*f_roll3
617 bvec(3, 1) = g3x3_list(iconst)%dbc*g3x3_list(iconst)%dbc &
618 - dtsqby2*dtsqby2*dot_product(vec, vec) - dot_product(r0_23, r0_23)
624 lg3x3(iconst)%lambda(:) = bvec(:, 1)
625 lg3x3(iconst)%del_lambda(:) = lg3x3(iconst)%lambda(:) - &
626 lg3x3(iconst)%lambda_old(:)
627 lg3x3(iconst)%lambda_old(:) = lg3x3(iconst)%lambda(:)
629 fc1 = lg3x3(iconst)%del_lambda(1)*lg3x3(iconst)%fa + &
630 lg3x3(iconst)%del_lambda(2)*lg3x3(iconst)%fb
631 fc2 = -lg3x3(iconst)%del_lambda(1)*lg3x3(iconst)%fa + &
632 lg3x3(iconst)%del_lambda(3)*lg3x3(iconst)%fc
633 fc3 = -lg3x3(iconst)%del_lambda(2)*lg3x3(iconst)%fb - &
634 lg3x3(iconst)%del_lambda(3)*lg3x3(iconst)%fc
635 r1(:) = pos(:, index_a) + imass1*dtsqby2*matmul(r_shake, fc1)
636 r2(:) = pos(:, index_b) + imass2*dtsqby2*matmul(r_shake, fc2)
637 r3(:) = pos(:, index_c) + imass3*dtsqby2*matmul(r_shake, fc3)
638 v1(:) = vel(:, index_a) + imass1*dtby2*matmul(v_shake, fc1)
639 v2(:) = vel(:, index_b) + imass2*dtby2*matmul(v_shake, fc2)
640 v3(:) = vel(:, index_c) + imass3*dtby2*matmul(v_shake, fc3)
646 sigma = dot_product(r12, r12) - g3x3_list(iconst)%dab* &
647 g3x3_list(iconst)%dab
648 max_sigma = max(max_sigma, abs(sigma))
649 sigma = dot_product(r13, r13) - g3x3_list(iconst)%dac* &
650 g3x3_list(iconst)%dac
651 max_sigma = max(max_sigma, abs(sigma))
652 sigma = dot_product(r23, r23) - g3x3_list(iconst)%dbc* &
653 g3x3_list(iconst)%dbc
654 max_sigma = max(max_sigma, abs(sigma))
657 pos(:, index_a) = r1(:)
658 pos(:, index_b) = r2(:)
659 pos(:, index_c) = r3(:)
662 vel(:, index_a) = v1(:)
663 vel(:, index_b) = v2(:)
664 vel(:, index_c) = v3(:)
666 END SUBROUTINE shake_roll_3x3_low
682 SUBROUTINE rattle_roll_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, &
683 particle_set, vel, r_rattle, dt, veps)
684 TYPE(fixd_constraint_type),
DIMENSION(:),
POINTER :: fixd_list
685 TYPE(g3x3_constraint_type),
POINTER :: g3x3_list(:)
686 TYPE(local_g3x3_constraint_type),
POINTER :: lg3x3(:)
687 INTEGER,
INTENT(IN) :: first_atom
688 TYPE(particle_type),
POINTER :: particle_set(:)
689 REAL(kind=
dp),
INTENT(INOUT) :: vel(:, :)
690 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: r_rattle
691 REAL(kind=
dp),
INTENT(in) :: dt
692 REAL(kind=
dp),
DIMENSION(:, :),
INTENT(IN) :: veps
694 INTEGER :: iconst, index_a, index_b, index_c
695 REAL(kind=
dp) :: dtby2, idt, imass1, imass2, imass3, mass
696 REAL(kind=
dp),
DIMENSION(3) :: f_roll1, f_roll2, f_roll3, fc1, fc2, &
697 fc3, lambda, r12, r13, r23, v12, v13, &
699 REAL(kind=
dp),
DIMENSION(3, 1) :: bvec
700 REAL(kind=
dp),
DIMENSION(3, 3) :: amat
701 TYPE(atomic_kind_type),
POINTER :: atomic_kind
705 DO iconst = 1,
SIZE(g3x3_list)
706 IF (g3x3_list(iconst)%restraint%active) cycle
707 index_a = g3x3_list(iconst)%a + first_atom - 1
708 index_b = g3x3_list(iconst)%b + first_atom - 1
709 index_c = g3x3_list(iconst)%c + first_atom - 1
710 v12(:) = vel(:, index_a) - vel(:, index_b)
711 v13(:) = vel(:, index_a) - vel(:, index_c)
712 v23(:) = vel(:, index_b) - vel(:, index_c)
713 r12(:) = particle_set(index_a)%r(:) - particle_set(index_b)%r(:)
714 r13(:) = particle_set(index_a)%r(:) - particle_set(index_c)%r(:)
715 r23(:) = particle_set(index_b)%r(:) - particle_set(index_c)%r(:)
716 atomic_kind => particle_set(index_a)%atomic_kind
719 atomic_kind => particle_set(index_b)%atomic_kind
722 atomic_kind => particle_set(index_c)%atomic_kind
725 lg3x3(iconst)%fa = -2.0_dp*r12
726 lg3x3(iconst)%fb = -2.0_dp*r13
727 lg3x3(iconst)%fc = -2.0_dp*r23
730 index_a, index_b, index_c, fixd_list, lg3x3(iconst))
732 f_roll1 = matmul(r_rattle, lg3x3(iconst)%fa)
733 f_roll2 = matmul(r_rattle, lg3x3(iconst)%fb)
734 f_roll3 = matmul(r_rattle, lg3x3(iconst)%fc)
737 amat(1, 1) = (imass1 + imass2)*dot_product(r12, f_roll1)
738 amat(1, 2) = imass1*dot_product(r12, f_roll2)
739 amat(1, 3) = -imass2*dot_product(r12, f_roll3)
740 amat(2, 1) = imass1*dot_product(r13, f_roll1)
741 amat(2, 2) = (imass1 + imass3)*dot_product(r13, f_roll2)
742 amat(2, 3) = imass3*dot_product(r13, f_roll3)
743 amat(3, 1) = -imass2*dot_product(r23, f_roll1)
744 amat(3, 2) = imass3*dot_product(r23, f_roll2)
745 amat(3, 3) = (imass2 + imass3)*dot_product(r23, f_roll3)
748 bvec(1, 1) = dot_product(r12, v12 + matmul(veps, r12))
749 bvec(2, 1) = dot_product(r13, v13 + matmul(veps, r13))
750 bvec(3, 1) = dot_product(r23, v23 + matmul(veps, r23))
751 bvec = -bvec*2.0_dp*idt
755 lambda(:) = bvec(:, 1)
756 lg3x3(iconst)%lambda(:) = lambda
758 fc1 = lambda(1)*f_roll1 + &
760 fc2 = -lambda(1)*f_roll1 + &
762 fc3 = -lambda(2)*f_roll2 - &
764 vel(:, index_a) = vel(:, index_a) + imass1*dtby2*fc1(:)
765 vel(:, index_b) = vel(:, index_b) + imass2*dtby2*fc2(:)
766 vel(:, index_c) = vel(:, index_c) + imass3*dtby2*fc3(:)
768 END SUBROUTINE rattle_roll_3x3_low
782 SUBROUTINE rattle_3x3_low(fixd_list, g3x3_list, lg3x3, first_atom, &
783 particle_set, vel, dt)
785 TYPE(fixd_constraint_type),
DIMENSION(:),
POINTER :: fixd_list
786 TYPE(g3x3_constraint_type),
POINTER :: g3x3_list(:)
787 TYPE(local_g3x3_constraint_type),
POINTER :: lg3x3(:)
788 INTEGER,
INTENT(IN) :: first_atom
789 TYPE(particle_type),
POINTER :: particle_set(:)
790 REAL(kind=
dp),
INTENT(INOUT) :: vel(:, :)
791 REAL(kind=
dp),
INTENT(in) :: dt
793 INTEGER :: iconst, index_a, index_b, index_c
794 REAL(kind=
dp) :: dtby2, idt, imass1, imass2, imass3, mass
795 REAL(kind=
dp),
DIMENSION(3) :: fc1, fc2, fc3, r12, r13, r23, v12, v13, &
797 REAL(kind=
dp),
DIMENSION(3, 1) :: bvec
798 REAL(kind=
dp),
DIMENSION(3, 3) :: amat
799 TYPE(atomic_kind_type),
POINTER :: atomic_kind
803 DO iconst = 1,
SIZE(g3x3_list)
804 IF (g3x3_list(iconst)%restraint%active) cycle
805 index_a = g3x3_list(iconst)%a + first_atom - 1
806 index_b = g3x3_list(iconst)%b + first_atom - 1
807 index_c = g3x3_list(iconst)%c + first_atom - 1
808 v12(:) = vel(:, index_a) - vel(:, index_b)
809 v13(:) = vel(:, index_a) - vel(:, index_c)
810 v23(:) = vel(:, index_b) - vel(:, index_c)
811 r12(:) = particle_set(index_a)%r(:) - particle_set(index_b)%r(:)
812 r13(:) = particle_set(index_a)%r(:) - particle_set(index_c)%r(:)
813 r23(:) = particle_set(index_b)%r(:) - particle_set(index_c)%r(:)
814 atomic_kind => particle_set(index_a)%atomic_kind
817 atomic_kind => particle_set(index_b)%atomic_kind
820 atomic_kind => particle_set(index_c)%atomic_kind
823 lg3x3(iconst)%fa = -2.0_dp*r12
824 lg3x3(iconst)%fb = -2.0_dp*r13
825 lg3x3(iconst)%fc = -2.0_dp*r23
828 index_a, index_b, index_c, fixd_list, lg3x3(iconst))
830 amat(1, 1) = (imass1 + imass2)*dot_product(r12, lg3x3(iconst)%fa)
831 amat(1, 2) = imass1*dot_product(r12, lg3x3(iconst)%fb)
832 amat(1, 3) = -imass2*dot_product(r12, lg3x3(iconst)%fc)
833 amat(2, 1) = imass1*dot_product(r13, lg3x3(iconst)%fa)
834 amat(2, 2) = (imass1 + imass3)*dot_product(r13, lg3x3(iconst)%fb)
835 amat(2, 3) = imass3*dot_product(r13, lg3x3(iconst)%fc)
836 amat(3, 1) = -imass2*dot_product(r23, lg3x3(iconst)%fa)
837 amat(3, 2) = imass3*dot_product(r23, lg3x3(iconst)%fb)
838 amat(3, 3) = (imass2 + imass3)*dot_product(r23, lg3x3(iconst)%fc)
841 bvec(1, 1) = dot_product(r12, v12)
842 bvec(2, 1) = dot_product(r13, v13)
843 bvec(3, 1) = dot_product(r23, v23)
844 bvec = -bvec*2.0_dp*idt
848 lg3x3(iconst)%lambda(:) = bvec(:, 1)
850 fc1 = lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa + &
851 lg3x3(iconst)%lambda(2)*lg3x3(iconst)%fb
852 fc2 = -lg3x3(iconst)%lambda(1)*lg3x3(iconst)%fa + &
853 lg3x3(iconst)%lambda(3)*lg3x3(iconst)%fc
854 fc3 = -lg3x3(iconst)%lambda(2)*lg3x3(iconst)%fb - &
855 lg3x3(iconst)%lambda(3)*lg3x3(iconst)%fc
856 vel(:, index_a) = vel(:, index_a) + imass1*dtby2*fc1(:)
857 vel(:, index_b) = vel(:, index_b) + imass2*dtby2*fc2(:)
858 vel(:, index_c) = vel(:, index_c) + imass3*dtby2*fc3(:)
860 END SUBROUTINE rattle_3x3_low
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
subroutine, public shake_3x3_ext(gci, particle_set, pos, vel, dt, ishake, max_sigma)
...
subroutine, public rattle_roll_3x3_ext(gci, particle_set, vel, r_rattle, dt, veps)
...
subroutine, public shake_roll_3x3_int(molecule, particle_set, pos, vel, r_shake, v_shake, dt, ishake, max_sigma)
...
subroutine, public rattle_3x3_int(molecule, particle_set, vel, dt)
...
subroutine, public shake_3x3_int(molecule, particle_set, pos, vel, dt, ishake, max_sigma)
...
subroutine, public rattle_3x3_ext(gci, particle_set, vel, dt)
...
subroutine, public shake_roll_3x3_ext(gci, particle_set, pos, vel, r_shake, v_shake, dt, ishake, max_sigma)
...
subroutine, public rattle_roll_3x3_int(molecule, particle_set, vel, r_rattle, dt, veps)
...
subroutine, public check_fixed_atom_cns_g3x3(imass1, imass2, imass3, index_a, index_b, index_c, fixd_list, lg3x3)
...
Defines the basic variable types.
integer, parameter, public dp
Provides interfaces to LAPACK routines for factorisation and linear system solving.
subroutine, public solve_system(matrix, mysize, eigenvectors)
...
Define the molecule kind structure types and the corresponding functionality.
subroutine, public get_molecule_kind(molecule_kind, atom_list, bond_list, bend_list, ub_list, impr_list, opbend_list, colv_list, fixd_list, g3x3_list, g4x6_list, vsite_list, torsion_list, shell_list, name, mass, charge, kind_number, natom, nbend, nbond, nub, nimpr, nopbend, nconstraint, nconstraint_fixd, nfixd, ncolv, ng3x3, ng4x6, nvsite, nfixd_restraint, ng3x3_restraint, ng4x6_restraint, nvsite_restraint, nrestraints, nmolecule, nsgf, nshell, ntorsion, molecule_list, nelectron, nelectron_alpha, nelectron_beta, bond_kind_set, bend_kind_set, ub_kind_set, impr_kind_set, opbend_kind_set, torsion_kind_set, molname_generated)
Get informations about a molecule kind.
Define the data structure for the molecule information.
subroutine, public get_molecule(molecule, molecule_kind, lmi, lci, lg3x3, lg4x6, lcolv, first_atom, last_atom, first_shell, last_shell)
Get components from a molecule data set.
Define the data structure for the particle information.