101 lreject, move_updates, energy_check, r_old, &
102 nnstep, old_energy, bias_energy_new, last_bias_energy, &
103 nboxes, box_flag, subsys, particles, rng_stream, &
107 DIMENSION(:),
POINTER :: mc_par
110 LOGICAL,
INTENT(IN) :: lreject
112 REAL(kind=
dp),
DIMENSION(:),
INTENT(INOUT) :: energy_check
113 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(INOUT) :: r_old
114 INTEGER,
INTENT(IN) :: nnstep
115 REAL(kind=
dp),
DIMENSION(:),
INTENT(INOUT) :: old_energy, bias_energy_new, &
117 INTEGER,
INTENT(IN) :: nboxes
118 INTEGER,
DIMENSION(:),
INTENT(IN) :: box_flag
122 REAL(kind=
dp),
INTENT(IN) :: unit_conv
124 CHARACTER(len=*),
PARAMETER :: routinen =
'mc_Quickstep_move'
126 INTEGER :: end_mol, handle, ibox, iparticle, &
127 iprint, itype, jbox, nmol_types, &
129 INTEGER,
DIMENSION(:, :),
POINTER :: nchains
130 INTEGER,
DIMENSION(:),
POINTER :: mol_type, nunits, nunits_tot
131 INTEGER,
DIMENSION(1:nboxes) :: diff
132 LOGICAL :: ionode, lbias, loverlap
133 REAL(kind=
dp) :: beta, energies, rand, w
134 REAL(kind=
dp),
DIMENSION(1:nboxes) :: bias_energy_old, new_energy
142 CALL timeset(routinen, handle)
144 NULLIFY (subsys_bias, particles_bias)
147 CALL get_mc_par(mc_par(1)%mc_par, ionode=ionode, lbias=lbias, &
148 beta=beta, diff=diff(1), source=source, group=group, &
150 mc_molecule_info=mc_molecule_info)
152 nchains=nchains, nunits_tot=nunits_tot, nunits=nunits, mol_type=mol_type)
154 IF (nboxes .GT. 1)
THEN
156 CALL get_mc_par(mc_par(ibox)%mc_par, diff=diff(ibox))
161 ALLOCATE (subsys_bias(1:nboxes))
162 ALLOCATE (particles_bias(1:nboxes))
166 moves(1, 1)%moves%Quickstep%attempts = &
167 moves(1, 1)%moves%Quickstep%attempts + 1
172 subsys=subsys(ibox)%subsys)
174 particles=particles(ibox)%list)
180 IF (box_flag(ibox) == 1)
THEN
184 subsys=subsys_bias(ibox)%subsys)
186 particles=particles_bias(ibox)%list)
188 DO iparticle = 1, nunits_tot(ibox)
189 particles(ibox)%list%els(iparticle)%r(1:3) = &
190 particles_bias(ibox)%list%els(iparticle)%r(1:3)
196 potential_energy=new_energy(ibox))
198 IF (.NOT. lreject)
THEN
202 potential_energy=new_energy(ibox))
206 new_energy(ibox) = old_energy(ibox)
215 IF (mod(nnstep, iprint) == 0)
THEN
217 IF (sum(nchains(:, ibox)) == 0)
THEN
218 WRITE (diff(ibox), *) nnstep
219 WRITE (diff(ibox), *) nchains(:, ibox)
221 WRITE (diff(ibox), *) nnstep
223 particles(ibox)%list%els, &
231 IF (.NOT. lreject)
THEN
236 IF (sum(nchains(:, ibox)) .NE. 0)
THEN
239 DO jbox = 1, ibox - 1
240 start_mol = start_mol + sum(nchains(:, jbox))
242 end_mol = start_mol + sum(nchains(:, ibox)) - 1
244 nchains(:, ibox), nunits(:), loverlap, mol_type(start_mol:end_mol))
246 cpabort(
'Quickstep move found an overlap in the old config')
248 bias_energy_old(ibox) = last_bias_energy(ibox)
251 energies = -beta*((sum(new_energy(:)) - sum(bias_energy_new(:))) &
252 - (sum(old_energy(:)) - sum(bias_energy_old(:))))
255 IF (energies .GE. -1.0e-8)
THEN
257 ELSEIF (energies .LE. -500.0_dp)
THEN
265 WRITE (diff(ibox), *) nnstep, new_energy(ibox) - &
267 bias_energy_new(ibox) - bias_energy_old(ibox)
271 energies = -beta*(sum(new_energy(:)) - sum(old_energy(:)))
273 IF (energies .GE. 0.0_dp)
THEN
275 ELSEIF (energies .LE. -500.0_dp)
THEN
284 IF (w .GE. 1.0e0_dp)
THEN
288 IF (ionode) rand = rng_stream%next()
289 CALL group%bcast(rand, source)
292 IF (rand .LT. w)
THEN
295 moves(1, 1)%moves%Quickstep%successes = &
296 moves(1, 1)%moves%Quickstep%successes + 1
300 IF (.NOT. lbias)
THEN
301 DO itype = 1, nmol_types
311 DO itype = 1, nmol_types
322 energy_check(ibox) = energy_check(ibox) + &
323 (new_energy(ibox) - old_energy(ibox))
324 old_energy(ibox) = new_energy(ibox)
330 last_bias_energy(ibox) = bias_energy_new(ibox)
336 IF (nunits_tot(ibox) .NE. 0)
THEN
337 DO iparticle = 1, nunits_tot(ibox)
338 r_old(1:3, iparticle, ibox) = &
339 particles(ibox)%list%els(iparticle)%r(1:3)
348 DO itype = 1, nmol_types
351 IF (.NOT. lbias)
THEN
360 IF (.NOT. ionode) r_old(:, :, :) = 0.0e0_dp
364 CALL group%bcast(r_old, source)
367 DO iparticle = 1, nunits_tot(ibox)
368 particles(ibox)%list%els(iparticle)%r(1:3) = &
369 r_old(1:3, iparticle, ibox)
370 IF (lbias .AND. box_flag(ibox) == 1) &
371 particles_bias(ibox)%list%els(iparticle)%r(1:3) = &
372 r_old(1:3, iparticle, ibox)
379 bias_energy_new(ibox) = last_bias_energy(ibox)
388 particles=particles(ibox)%list)
389 IF (lbias .AND. box_flag(ibox) == 1) &
391 particles=particles_bias(ibox)%list)
395 DEALLOCATE (subsys_bias)
396 DEALLOCATE (particles_bias)
399 CALL timestop(handle)
425 energy_check, r_old, old_energy, input_declaration, &
426 para_env, bias_energy_old, last_bias_energy, &
430 DIMENSION(:),
POINTER :: mc_par
433 REAL(kind=
dp),
DIMENSION(1:2),
INTENT(INOUT) :: energy_check
434 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(INOUT) :: r_old
435 REAL(kind=
dp),
DIMENSION(1:2),
INTENT(INOUT) :: old_energy
438 REAL(kind=
dp),
DIMENSION(1:2),
INTENT(INOUT) :: bias_energy_old, last_bias_energy
441 CHARACTER(len=*),
PARAMETER :: routinen =
'mc_ge_swap_move'
443 CHARACTER(default_string_length),
ALLOCATABLE, &
444 DIMENSION(:) :: atom_names_insert, atom_names_remove
445 CHARACTER(default_string_length), &
446 DIMENSION(:, :),
POINTER :: atom_names
448 CHARACTER(LEN=40),
DIMENSION(1:2) :: dat_file
449 INTEGER :: end_mol, handle, iatom, ibox, idim, iiatom, imolecule, ins_atoms, insert_box, &
450 ipart, itype, jbox, molecule_type, nmol_types, nswapmoves, print_level, rem_atoms, &
451 remove_box, source, start_atom_ins, start_atom_rem, start_mol
452 INTEGER,
DIMENSION(:),
POINTER :: mol_type, mol_type_test, nunits, &
454 INTEGER,
DIMENSION(:, :),
POINTER :: nchains, nchains_test
455 LOGICAL :: ionode, lbias, loverlap, loverlap_ins, &
457 REAL(
dp),
DIMENSION(:),
POINTER :: eta_insert, eta_remove, pmswap_mol
458 REAL(
dp),
DIMENSION(:, :),
POINTER :: insert_coords, remove_coords
459 REAL(kind=
dp) :: beta, del_quickstep_energy, exp_max_val, exp_min_val, max_val, min_val, &
460 prefactor, rand, rdum, vol_insert, vol_remove, w, weight_new, weight_old
461 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: cbmc_energies, r_cbmc, r_insert_mol
462 REAL(kind=
dp),
DIMENSION(1:2) :: bias_energy_new, new_energy
463 REAL(kind=
dp),
DIMENSION(1:3) :: abc_insert, abc_remove, center_of_mass, &
464 displace_molecule, pos_insert
465 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: mass
466 TYPE(
cell_type),
POINTER :: cell_insert, cell_remove
478 CALL timeset(routinen, handle)
484 NULLIFY (particles_old, mol_type, mol_type_test, mc_input_file, mc_bias_file)
485 NULLIFY (oldsys, atom_names, pmswap_mol, insert_coords, remove_coords)
486 NULLIFY (eta_insert, eta_remove)
489 CALL get_mc_par(mc_par(1)%mc_par, ionode=ionode, beta=beta, &
490 max_val=max_val, min_val=min_val, exp_max_val=exp_max_val, &
491 exp_min_val=exp_min_val, nswapmoves=nswapmoves, group=group, source=source, &
493 mc_molecule_info=mc_molecule_info, pmswap_mol=pmswap_mol)
495 nunits=nunits, nunits_tot=nunits_tot, nmol_types=nmol_types, &
496 atom_names=atom_names, mass=mass, mol_type=mol_type)
500 CALL get_mc_par(mc_par(2)%mc_par, dat_file=dat_file(2))
503 ALLOCATE (oldsys(1:2))
504 ALLOCATE (particles_old(1:2))
509 subsys=oldsys(ibox)%subsys)
511 particles=particles_old(ibox)%list)
515 IF (ionode) rand = rng_stream%next()
516 CALL group%bcast(rand, source)
518 IF (rand .LE. 0.50e0_dp)
THEN
527 CALL get_mc_par(mc_par(remove_box)%mc_par, eta=eta_remove)
528 CALL get_mc_par(mc_par(insert_box)%mc_par, eta=eta_insert)
535 IF (ionode) rand = rng_stream%next()
536 CALL group%bcast(rand, source)
537 DO itype = 1, nmol_types
538 IF (rand .LT. pmswap_mol(itype))
THEN
539 molecule_type = itype
545 moves(molecule_type, insert_box)%moves%swap%attempts = &
546 moves(molecule_type, insert_box)%moves%swap%attempts + 1
550 IF (nchains(molecule_type, remove_box) == 0)
THEN
552 moves(molecule_type, insert_box)%moves%empty = &
553 moves(molecule_type, insert_box)%moves%empty + 1
556 IF (ionode) rand = rng_stream%next()
557 CALL group%bcast(rand, source)
558 imolecule = ceiling(rand*nchains(molecule_type, remove_box))
561 DO itype = 1, nmol_types
562 IF (itype == molecule_type)
THEN
563 start_atom_rem = start_atom_rem + (imolecule - 1)*nunits(itype)
566 start_atom_rem = start_atom_rem + nchains(itype, remove_box)*nunits(itype)
572 DO jbox = 1, remove_box - 1
573 start_mol = start_mol + sum(nchains(:, jbox))
575 end_mol = start_mol + sum(nchains(:, remove_box)) - 1
577 nchains(:, remove_box), nunits, loverlap, mol_type(start_mol:end_mol))
578 IF (loverlap)
CALL cp_abort(__location__, &
579 'CBMC swap move found an overlap in the old remove config')
581 DO jbox = 1, insert_box - 1
582 start_mol = start_mol + sum(nchains(:, jbox))
584 end_mol = start_mol + sum(nchains(:, insert_box)) - 1
586 nchains(:, insert_box), nunits, loverlap, mol_type(start_mol:end_mol))
587 IF (loverlap)
CALL cp_abort(__location__, &
588 'CBMC swap move found an overlap in the old insert config')
593 DEALLOCATE (particles_old)
594 CALL timestop(handle)
599 ins_atoms = nunits_tot(insert_box) + nunits(molecule_type)
600 rem_atoms = nunits_tot(remove_box) - nunits(molecule_type)
603 IF (rem_atoms == 0)
THEN
604 ALLOCATE (remove_coords(1:3, 1:nunits(1)))
605 ALLOCATE (atom_names_remove(1:nunits(1)))
607 ALLOCATE (remove_coords(1:3, 1:rem_atoms))
608 ALLOCATE (atom_names_remove(1:rem_atoms))
610 ALLOCATE (insert_coords(1:3, 1:ins_atoms))
611 ALLOCATE (atom_names_insert(1:ins_atoms))
625 CALL get_cell(cell_remove, abc=abc_remove, deth=vol_remove)
626 CALL get_cell(cell_insert, abc=abc_insert, deth=vol_insert)
631 rand = rng_stream%next()
632 pos_insert(idim) = rand*abc_insert(idim)
635 CALL group%bcast(pos_insert, source)
638 ALLOCATE (r_insert_mol(1:3, 1:nunits(molecule_type)))
641 DO iatom = start_atom_rem, start_atom_rem + nunits(molecule_type) - 1
642 r_insert_mol(1:3, iiatom) = &
643 particles_old(remove_box)%list%els(iatom)%r(1:3)
649 center_of_mass(:), mass(:, molecule_type))
652 displace_molecule(1:3) = pos_insert(1:3) - center_of_mass(1:3)
653 DO iatom = 1, nunits(molecule_type)
654 r_insert_mol(1:3, iatom) = r_insert_mol(1:3, iatom) + &
655 displace_molecule(1:3)
661 IF (sum(nchains(:, insert_box)) == 0)
THEN
662 DO iatom = 1, nunits(molecule_type)
663 insert_coords(1:3, iatom) = r_insert_mol(1:3, iatom)
664 atom_names_insert(iatom) = &
665 particles_old(remove_box)%list%els(start_atom_rem + iatom - 1)%atomic_kind%name
675 DO itype = 1, nmol_types
676 start_atom_ins = start_atom_ins + &
677 nchains(itype, insert_box)*nunits(itype)
678 IF (itype == molecule_type)
EXIT
681 DO iatom = 1, start_atom_ins - 1
682 insert_coords(1:3, iatom) = &
683 particles_old(insert_box)%list%els(iatom)%r(1:3)
684 atom_names_insert(iatom) = &
685 particles_old(insert_box)%list%els(iatom)%atomic_kind%name
688 DO iatom = start_atom_ins, start_atom_ins + nunits(molecule_type) - 1
689 insert_coords(1:3, iatom) = r_insert_mol(1:3, iiatom)
690 atom_names_insert(iatom) = atom_names(iiatom, molecule_type)
693 DO iatom = start_atom_ins + nunits(molecule_type), ins_atoms
694 insert_coords(1:3, iatom) = &
695 particles_old(insert_box)%list%els(iatom - nunits(molecule_type))%r(1:3)
696 atom_names_insert(iatom) = &
697 particles_old(insert_box)%list%els(iatom - nunits(molecule_type))%atomic_kind%name
703 DO jbox = 1, insert_box - 1
704 start_mol = start_mol + sum(nchains(:, jbox))
706 end_mol = start_mol + sum(nchains(:, insert_box)) - 1
711 nchains(molecule_type, insert_box) = nchains(molecule_type, insert_box) + 1
713 CALL get_mc_par(mc_par(insert_box)%mc_par, mc_bias_file=mc_bias_file)
715 abc_insert(:), dat_file(insert_box), nchains(:, insert_box), &
718 CALL get_mc_par(mc_par(insert_box)%mc_par, mc_input_file=mc_input_file)
720 abc_insert(:), dat_file(insert_box), nchains(:, insert_box), &
723 nchains(molecule_type, insert_box) = nchains(molecule_type, insert_box) - 1
728 IF (rem_atoms == 0)
THEN
729 DO iatom = 1, nunits(molecule_type)
730 remove_coords(1:3, iatom) = r_insert_mol(1:3, iatom)
731 atom_names_remove(iatom) = atom_names(iatom, molecule_type)
737 nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) - 1
740 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_bias_file=mc_bias_file)
742 abc_remove(:), dat_file(remove_box), nchains(:, remove_box), &
745 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_input_file=mc_input_file)
747 abc_remove(:), dat_file(remove_box), nchains(:, remove_box), &
752 nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) + 1
755 DO iatom = 1, start_atom_rem - 1
756 remove_coords(1:3, iatom) = &
757 particles_old(remove_box)%list%els(iatom)%r(1:3)
758 atom_names_remove(iatom) = &
759 particles_old(remove_box)%list%els(iatom)%atomic_kind%name
761 DO iatom = start_atom_rem + nunits(molecule_type), nunits_tot(remove_box)
762 remove_coords(1:3, iatom - nunits(molecule_type)) = &
763 particles_old(remove_box)%list%els(iatom)%r(1:3)
764 atom_names_remove(iatom - nunits(molecule_type)) = &
765 particles_old(remove_box)%list%els(iatom)%atomic_kind%name
770 nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) - 1
772 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_bias_file=mc_bias_file)
774 abc_remove(:), dat_file(remove_box), nchains(:, remove_box), &
777 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_input_file=mc_input_file)
779 abc_remove(:), dat_file(remove_box), nchains(:, remove_box), &
782 nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) + 1
788 DEALLOCATE (r_insert_mol)
792 ALLOCATE (test_env(1:2))
794 para_env, dat_file(insert_box))
796 para_env, dat_file(remove_box))
799 ALLOCATE (r_cbmc(1:3, 1:ins_atoms))
800 ALLOCATE (cbmc_energies(1:nswapmoves, 1:2))
802 loverlap_ins = .false.
803 loverlap_rem = .false.
806 IF (rem_atoms == 0)
THEN
808 box_number=remove_box)
813 mol_type=mol_type_test)
818 DO jbox = 1, insert_box - 1
819 start_mol = start_mol + sum(nchains_test(:, jbox))
821 end_mol = start_mol + sum(nchains_test(:, insert_box)) - 1
825 beta, max_val, min_val, exp_max_val, &
826 exp_min_val, nswapmoves, weight_new, start_atom_ins, ins_atoms, nunits(:), &
827 nunits(molecule_type), mass(:, molecule_type), loverlap_ins, bias_energy_new(insert_box), &
828 bias_energy_old(insert_box), ionode, .false., mol_type_test(start_mol:end_mol), &
829 nchains_test(:, insert_box), source, group, rng_stream)
835 bias_energy_new(insert_box) = bias_energy_new(insert_box) + &
836 bias_energy_old(insert_box)
839 beta, max_val, min_val, exp_max_val, &
840 exp_min_val, nswapmoves, weight_new, start_atom_ins, ins_atoms, nunits(:), &
841 nunits(molecule_type), mass(:, molecule_type), loverlap_ins, new_energy(insert_box), &
842 old_energy(insert_box), ionode, .false., mol_type_test(start_mol:end_mol), &
843 nchains_test(:, insert_box), source, group, rng_stream)
849 particles=particles_insert)
851 DO iatom = 1, ins_atoms
852 r_cbmc(1:3, iatom) = particles_insert%els(iatom)%r(1:3)
857 IF (loverlap_ins .OR. loverlap_rem)
THEN
862 DEALLOCATE (insert_coords)
863 DEALLOCATE (remove_coords)
865 DEALLOCATE (cbmc_energies)
867 DEALLOCATE (particles_old)
868 DEALLOCATE (test_env)
869 CALL timestop(handle)
878 particles=particles_insert)
880 DO iatom = 1, ins_atoms
881 particles_insert%els(iatom)%r(1:3) = &
886 moves(molecule_type, insert_box)%moves%grown = &
887 moves(molecule_type, insert_box)%moves%grown + 1
893 ALLOCATE (test_env_bias(1:2))
896 CALL get_mc_par(mc_par(insert_box)%mc_par, mc_input_file=mc_input_file)
898 abc_insert(:), dat_file(insert_box), nchains_test(:, insert_box), &
900 test_env_bias(insert_box)%force_env => test_env(insert_box)%force_env
901 NULLIFY (test_env(insert_box)%force_env)
903 para_env, dat_file(insert_box))
908 potential_energy=new_energy(insert_box))
911 IF (sum(nchains_test(:, remove_box)) == 0)
THEN
912 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_input_file=mc_input_file)
914 abc_remove(:), dat_file(remove_box), nchains_test(:, remove_box), &
916 test_env_bias(remove_box)%force_env => test_env(remove_box)%force_env
917 NULLIFY (test_env(remove_box)%force_env)
919 para_env, dat_file(remove_box))
920 new_energy(remove_box) = 0.0e0_dp
921 bias_energy_new(remove_box) = 0.0e0_dp
923 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_input_file=mc_input_file)
925 abc_remove(:), dat_file(remove_box), nchains_test(:, remove_box), &
927 test_env_bias(remove_box)%force_env => test_env(remove_box)%force_env
928 NULLIFY (test_env(remove_box)%force_env)
930 para_env, dat_file(remove_box))
934 potential_energy=new_energy(remove_box))
938 potential_energy=bias_energy_new(remove_box))
941 IF (sum(nchains_test(:, remove_box)) == 0)
THEN
942 new_energy(remove_box) = 0.0e0_dp
947 potential_energy=new_energy(remove_box))
957 DO jbox = 1, remove_box - 1
958 start_mol = start_mol + sum(nchains(:, jbox))
960 end_mol = start_mol + sum(nchains(:, remove_box)) - 1
963 beta, max_val, min_val, exp_max_val, &
964 exp_min_val, nswapmoves, weight_old, start_atom_rem, nunits_tot(remove_box), &
965 nunits(:), nunits(molecule_type), mass(:, molecule_type), loverlap_rem, rdum, &
966 bias_energy_new(remove_box), ionode, .true., mol_type(start_mol:end_mol), &
967 nchains(:, remove_box), source, group, rng_stream)
970 beta, max_val, min_val, exp_max_val, &
971 exp_min_val, nswapmoves, weight_old, start_atom_rem, nunits_tot(remove_box), &
972 nunits(:), nunits(molecule_type), mass(:, molecule_type), loverlap_rem, rdum, &
973 new_energy(remove_box), ionode, .true., mol_type(start_mol:end_mol), &
974 nchains(:, remove_box), source, group, rng_stream)
980 prefactor = real(nchains(molecule_type, remove_box),
dp)/ &
981 REAL(nchains(molecule_type, insert_box) + 1,
dp)* &
982 vol_insert/vol_remove
986 del_quickstep_energy = (-beta)*(new_energy(insert_box) - &
987 old_energy(insert_box) + new_energy(remove_box) - &
988 old_energy(remove_box) - (bias_energy_new(insert_box) + &
989 bias_energy_new(remove_box) - bias_energy_old(insert_box) &
990 - bias_energy_old(remove_box)))
992 IF (del_quickstep_energy .GT. exp_max_val)
THEN
993 del_quickstep_energy = max_val
994 ELSEIF (del_quickstep_energy .LT. exp_min_val)
THEN
995 del_quickstep_energy = min_val
997 del_quickstep_energy = exp(del_quickstep_energy)
999 w = prefactor*del_quickstep_energy*weight_new/weight_old &
1000 *exp(beta*(eta_remove(molecule_type) - eta_insert(molecule_type)))
1003 w = prefactor*weight_new/weight_old &
1004 *exp(beta*(eta_remove(molecule_type) - eta_insert(molecule_type)))
1009 IF (w .GE. 1.0e0_dp)
THEN
1012 IF (ionode) rand = rng_stream%next()
1013 CALL group%bcast(rand, source)
1017 IF (rand .LT. w)
THEN
1022 moves(molecule_type, insert_box)%moves%swap%successes = &
1023 moves(molecule_type, insert_box)%moves%swap%successes + 1
1027 IF (.NOT. lbias)
THEN
1028 new_energy(insert_box) = new_energy(insert_box) + &
1029 old_energy(insert_box)
1034 energy_check(ibox) = energy_check(ibox) + (new_energy(ibox) - &
1036 old_energy(ibox) = new_energy(ibox)
1039 last_bias_energy(ibox) = bias_energy_new(ibox)
1040 bias_energy_old(ibox) = bias_energy_new(ibox)
1049 CALL set_mc_par(mc_par(insert_box)%mc_par, mc_molecule_info=mc_molecule_info_test)
1050 CALL set_mc_par(mc_par(remove_box)%mc_par, mc_molecule_info=mc_molecule_info_test)
1056 particles=particles_insert)
1057 DO ipart = 1, ins_atoms
1058 r_old(1:3, ipart, insert_box) = particles_insert%els(ipart)%r(1:3)
1063 particles=particles_remove)
1064 DO ipart = 1, rem_atoms
1065 r_old(1:3, ipart, remove_box) = particles_remove%els(ipart)%r(1:3)
1070 force_env(insert_box)%force_env => test_env(insert_box)%force_env
1074 force_env(remove_box)%force_env => test_env(remove_box)%force_env
1079 bias_env(insert_box)%force_env => test_env_bias(insert_box)%force_env
1081 bias_env(remove_box)%force_env => test_env_bias(remove_box)%force_env
1082 DEALLOCATE (test_env_bias)
1094 DEALLOCATE (test_env_bias)
1099 DEALLOCATE (insert_coords)
1100 DEALLOCATE (remove_coords)
1101 DEALLOCATE (test_env)
1102 DEALLOCATE (cbmc_energies)
1105 DEALLOCATE (particles_old)
1108 CALL timestop(handle)
1133 nnstep, old_energy, energy_check, r_old, rng_stream)
1136 DIMENSION(:),
POINTER :: mc_par
1138 TYPE(
mc_moves_p_type),
DIMENSION(:, :),
POINTER :: moves, move_updates
1139 INTEGER,
INTENT(IN) :: nnstep
1140 REAL(kind=
dp),
DIMENSION(:),
INTENT(INOUT) :: old_energy, energy_check
1141 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(INOUT) :: r_old
1144 CHARACTER(len=*),
PARAMETER :: routinen =
'mc_ge_volume_move'
1147 CHARACTER(LEN=40),
DIMENSION(1:2) :: dat_file
1148 INTEGER :: cl, end_atom, end_mol, handle, iatom, ibox, imolecule, iside, j, jatom, jbox, &
1149 max_atoms, molecule_index, molecule_type, print_level, source, start_atom, start_mol
1150 INTEGER,
DIMENSION(:),
POINTER :: mol_type, nunits, nunits_tot
1151 INTEGER,
DIMENSION(:, :),
POINTER :: nchains
1153 LOGICAL,
ALLOCATABLE,
DIMENSION(:) :: loverlap
1154 LOGICAL,
DIMENSION(1:2) :: lempty
1155 REAL(
dp),
DIMENSION(:, :),
POINTER :: mass
1156 REAL(kind=
dp) :: beta, prefactor, rand, rmvolume, &
1158 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :, :) :: r
1159 REAL(kind=
dp),
DIMENSION(1:2) :: new_energy, volume_new, volume_old
1160 REAL(kind=
dp),
DIMENSION(1:3) :: center_of_mass, center_of_mass_new, diff
1161 REAL(kind=
dp),
DIMENSION(1:3, 1:2) :: abc, new_cell_length, old_cell_length
1162 REAL(kind=
dp),
DIMENSION(1:3, 1:3, 1:2) :: hmat_test
1163 TYPE(
cell_p_type),
DIMENSION(:),
POINTER :: cell, cell_old, cell_test
1172 CALL timeset(routinen, handle)
1175 NULLIFY (particles_old, cell, oldsys, cell_old, cell_test, subsys)
1178 CALL get_mc_par(mc_par(1)%mc_par, ionode=ionode, source=source, &
1179 group=group, dat_file=dat_file(1), rmvolume=rmvolume, &
1181 mc_molecule_info=mc_molecule_info)
1183 mass=mass, nchains=nchains, nunits=nunits, mol_type=mol_type)
1186 CALL get_mc_par(mc_par(2)%mc_par, dat_file=dat_file(2))
1189 max_atoms = max(nunits_tot(1), nunits_tot(2))
1190 ALLOCATE (r(1:3, max_atoms, 1:2))
1191 ALLOCATE (oldsys(1:2))
1192 ALLOCATE (particles_old(1:2))
1193 ALLOCATE (cell(1:2))
1194 ALLOCATE (cell_test(1:2))
1195 ALLOCATE (cell_old(1:2))
1196 ALLOCATE (loverlap(1:2))
1201 lempty(ibox) = .false.
1202 IF (sum(nchains(:, ibox)) == 0)
THEN
1203 lempty(ibox) = .true.
1209 moves(1, ibox)%moves%volume%attempts = &
1210 moves(1, ibox)%moves%volume%attempts + 1
1211 move_updates(1, ibox)%moves%volume%attempts = &
1212 move_updates(1, ibox)%moves%volume%attempts + 1
1218 subsys=oldsys(ibox)%subsys, cell=cell(ibox)%cell)
1219 CALL get_cell(cell(ibox)%cell, abc=abc(:, ibox))
1220 NULLIFY (cell_old(ibox)%cell)
1222 CALL cell_clone(cell(ibox)%cell, cell_old(ibox)%cell, tag=
"CELL_OLD")
1224 particles=particles_old(ibox)%list)
1227 old_cell_length(1:3, ibox) = abc(1:3, ibox)
1234 DO iatom = 1, nunits_tot(ibox)
1235 r(1:3, iatom, ibox) = particles_old(ibox)%list%els(iatom)%r(1:3)
1241 IF (ionode) rand = rng_stream%next()
1242 CALL group%bcast(rand, source)
1244 vol_dis = rmvolume*(rand - 0.5e0_dp)*2.0e0_dp
1247 IF (old_cell_length(1, 1)*old_cell_length(2, 1)* &
1248 old_cell_length(3, 1) + vol_dis .LE. (3.0e0_dp/
angstrom)**3) &
1249 cpabort(
'GE_volume moves are trying to make box 1 smaller than 3')
1250 IF (old_cell_length(1, 2)*old_cell_length(2, 2)* &
1251 old_cell_length(3, 2) + vol_dis .LE. (3.0e0_dp/
angstrom)**3) &
1252 cpabort(
'GE_volume moves are trying to make box 2 smaller than 3')
1255 new_cell_length(iside, 1) = (old_cell_length(1, 1)**3 + &
1256 vol_dis)**(1.0e0_dp/3.0e0_dp)
1257 new_cell_length(iside, 2) = (old_cell_length(1, 2)**3 - &
1258 vol_dis)**(1.0e0_dp/3.0e0_dp)
1263 hmat_test(:, :, ibox) = 0.0e0_dp
1264 hmat_test(1, 1, ibox) = new_cell_length(1, ibox)
1265 hmat_test(2, 2, ibox) = new_cell_length(2, ibox)
1266 hmat_test(3, 3, ibox) = new_cell_length(3, ibox)
1267 NULLIFY (cell_test(ibox)%cell)
1268 CALL cell_create(cell_test(ibox)%cell, hmat=hmat_test(:, :, ibox), &
1269 periodic=cell(ibox)%cell%perd)
1270 CALL force_env_get(force_env(ibox)%force_env, subsys=subsys)
1277 DO iatom = 1, nunits_tot(ibox)
1278 r(1:3, iatom, ibox) = particles_old(ibox)%list%els(iatom)%r(1:3)
1285 DO jbox = 1, ibox - 1
1286 IF (jbox == ibox)
EXIT
1287 molecule_index = molecule_index + sum(nchains(:, jbox))
1289 DO imolecule = 1, sum(nchains(:, ibox))
1290 molecule_type = mol_type(imolecule + molecule_index - 1)
1291 IF (imolecule .NE. 1)
THEN
1292 start_atom = start_atom + nunits(mol_type(imolecule + molecule_index - 2))
1294 end_atom = start_atom + nunits(molecule_type) - 1
1298 nunits(molecule_type), center_of_mass(:), mass(:, molecule_type))
1302 center_of_mass_new(1:3) = center_of_mass(1:3)* &
1303 new_cell_length(1:3, ibox)/old_cell_length(1:3, ibox)
1305 diff(j) = center_of_mass_new(j) - center_of_mass(j)
1307 DO jatom = start_atom, end_atom
1308 particles_old(ibox)%list%els(jatom)%r(j) = &
1309 particles_old(ibox)%list%els(jatom)%r(j) + diff(j)
1317 DO jbox = 1, ibox - 1
1318 start_mol = start_mol + sum(nchains(:, jbox))
1320 end_mol = start_mol + sum(nchains(:, ibox)) - 1
1322 nchains(:, ibox), nunits, loverlap(ibox), mol_type(start_mol:end_mol), &
1323 cell_length=new_cell_length(:, ibox))
1330 IF (loverlap(ibox)) cycle
1332 IF (lempty(ibox))
THEN
1333 new_energy(ibox) = 0.0e0_dp
1339 potential_energy=new_energy(ibox))
1346 volume_new(ibox) = new_cell_length(1, ibox)* &
1347 new_cell_length(2, ibox)*new_cell_length(3, ibox)
1348 volume_old(ibox) = old_cell_length(1, ibox)* &
1349 old_cell_length(2, ibox)*old_cell_length(3, ibox)
1351 prefactor = (volume_new(1)/volume_old(1))**(sum(nchains(:, 1)))* &
1352 (volume_new(2)/volume_old(2))**(sum(nchains(:, 2)))
1354 IF (loverlap(1) .OR. loverlap(2))
THEN
1357 w = prefactor*exp(-beta* &
1358 (new_energy(1) + new_energy(2) - &
1359 old_energy(1) - old_energy(2)))
1363 IF (w .GE. 1.0e0_dp)
THEN
1367 IF (ionode) rand = rng_stream%next()
1368 CALL group%bcast(rand, source)
1371 IF (rand .LT. w)
THEN
1376 WRITE (cl, *) nnstep, new_cell_length(1, 1)* &
1379 WRITE (cl, *) nnstep, new_energy(1), &
1380 old_energy(1), new_energy(2), old_energy(2)
1381 WRITE (cl, *) prefactor, w
1386 moves(1, ibox)%moves%volume%successes = &
1387 moves(1, ibox)%moves%volume%successes + 1
1388 move_updates(1, ibox)%moves%volume%successes = &
1389 move_updates(1, ibox)%moves%volume%successes + 1
1392 energy_check(ibox) = energy_check(ibox) + (new_energy(ibox) - &
1394 old_energy(ibox) = new_energy(ibox)
1397 DO iatom = 1, nunits_tot(ibox)
1398 r_old(1:3, iatom, ibox) = &
1399 particles_old(ibox)%list%els(iatom)%r(1:3)
1409 WRITE (cl, *) nnstep, new_cell_length(1, 1)* &
1412 WRITE (cl, *) nnstep, new_energy(1), &
1413 old_energy(1), new_energy(2), old_energy(2)
1414 WRITE (cl, *) prefactor, w
1420 CALL force_env_get(force_env(ibox)%force_env, subsys=subsys)
1422 DO iatom = 1, nunits_tot(ibox)
1423 particles_old(ibox)%list%els(iatom)%r(1:3) = r_old(1:3, iatom, ibox)
1436 DEALLOCATE (particles_old)
1438 DEALLOCATE (cell_old)
1439 DEALLOCATE (cell_test)
1440 DEALLOCATE (loverlap)
1443 CALL timestop(handle)