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)
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)) /= 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')
249 bias_energy_old(ibox) = last_bias_energy(ibox)
252 energies = -beta*((sum(new_energy(:)) - sum(bias_energy_new(:))) &
253 - (sum(old_energy(:)) - sum(bias_energy_old(:))))
256 IF (energies >= -1.0e-8)
THEN
258 ELSE IF (energies <= -500.0_dp)
THEN
266 WRITE (diff(ibox), *) nnstep, new_energy(ibox) - &
268 bias_energy_new(ibox) - bias_energy_old(ibox)
272 energies = -beta*(sum(new_energy(:)) - sum(old_energy(:)))
274 IF (energies >= 0.0_dp)
THEN
276 ELSE IF (energies <= -500.0_dp)
THEN
285 IF (w >= 1.0e0_dp)
THEN
289 IF (ionode) rand = rng_stream%next()
290 CALL group%bcast(rand, source)
296 moves(1, 1)%moves%Quickstep%successes = &
297 moves(1, 1)%moves%Quickstep%successes + 1
301 IF (.NOT. lbias)
THEN
302 DO itype = 1, nmol_types
312 DO itype = 1, nmol_types
323 energy_check(ibox) = energy_check(ibox) + &
324 (new_energy(ibox) - old_energy(ibox))
325 old_energy(ibox) = new_energy(ibox)
331 last_bias_energy(ibox) = bias_energy_new(ibox)
337 IF (nunits_tot(ibox) /= 0)
THEN
338 DO iparticle = 1, nunits_tot(ibox)
339 r_old(1:3, iparticle, ibox) = &
340 particles(ibox)%list%els(iparticle)%r(1:3)
349 DO itype = 1, nmol_types
352 IF (.NOT. lbias)
THEN
361 IF (.NOT. ionode) r_old(:, :, :) = 0.0e0_dp
365 CALL group%bcast(r_old, source)
368 DO iparticle = 1, nunits_tot(ibox)
369 particles(ibox)%list%els(iparticle)%r(1:3) = &
370 r_old(1:3, iparticle, ibox)
371 IF (lbias .AND. box_flag(ibox) == 1)
THEN
372 particles_bias(ibox)%list%els(iparticle)%r(1:3) = &
373 r_old(1:3, iparticle, ibox)
381 bias_energy_new(ibox) = last_bias_energy(ibox)
390 particles=particles(ibox)%list)
391 IF (lbias .AND. box_flag(ibox) == 1)
THEN
393 particles=particles_bias(ibox)%list)
398 DEALLOCATE (subsys_bias)
399 DEALLOCATE (particles_bias)
402 CALL timestop(handle)
428 energy_check, r_old, old_energy, input_declaration, &
429 para_env, bias_energy_old, last_bias_energy, &
433 DIMENSION(:),
POINTER :: mc_par
436 REAL(kind=
dp),
DIMENSION(1:2),
INTENT(INOUT) :: energy_check
437 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(INOUT) :: r_old
438 REAL(kind=
dp),
DIMENSION(1:2),
INTENT(INOUT) :: old_energy
441 REAL(kind=
dp),
DIMENSION(1:2),
INTENT(INOUT) :: bias_energy_old, last_bias_energy
444 CHARACTER(len=*),
PARAMETER :: routinen =
'mc_ge_swap_move'
446 CHARACTER(default_string_length),
ALLOCATABLE, &
447 DIMENSION(:) :: atom_names_insert, atom_names_remove
448 CHARACTER(default_string_length), &
449 DIMENSION(:, :),
POINTER :: atom_names
451 CHARACTER(LEN=40),
DIMENSION(1:2) :: dat_file
452 INTEGER :: end_mol, handle, iatom, ibox, idim, iiatom, imolecule, ins_atoms, insert_box, &
453 ipart, itype, jbox, molecule_type, nmol_types, nswapmoves, print_level, rem_atoms, &
454 remove_box, source, start_atom_ins, start_atom_rem, start_mol
455 INTEGER,
DIMENSION(:),
POINTER :: mol_type, mol_type_test, nunits, &
457 INTEGER,
DIMENSION(:, :),
POINTER :: nchains, nchains_test
458 LOGICAL :: ionode, lbias, loverlap, loverlap_ins, &
460 REAL(
dp),
DIMENSION(:),
POINTER :: eta_insert, eta_remove, pmswap_mol
461 REAL(
dp),
DIMENSION(:, :),
POINTER :: insert_coords, remove_coords
462 REAL(kind=
dp) :: beta, del_quickstep_energy, exp_max_val, exp_min_val, max_val, min_val, &
463 prefactor, rand, rdum, vol_insert, vol_remove, w, weight_new, weight_old
464 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: cbmc_energies, r_cbmc, r_insert_mol
465 REAL(kind=
dp),
DIMENSION(1:2) :: bias_energy_new, new_energy
466 REAL(kind=
dp),
DIMENSION(1:3) :: abc_insert, abc_remove, center_of_mass, &
467 displace_molecule, pos_insert
468 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: mass
469 TYPE(
cell_type),
POINTER :: cell_insert, cell_remove
481 CALL timeset(routinen, handle)
487 NULLIFY (particles_old, mol_type, mol_type_test, mc_input_file, mc_bias_file)
488 NULLIFY (oldsys, atom_names, pmswap_mol, insert_coords, remove_coords)
489 NULLIFY (eta_insert, eta_remove)
492 CALL get_mc_par(mc_par(1)%mc_par, ionode=ionode, beta=beta, &
493 max_val=max_val, min_val=min_val, exp_max_val=exp_max_val, &
494 exp_min_val=exp_min_val, nswapmoves=nswapmoves, group=group, source=source, &
496 mc_molecule_info=mc_molecule_info, pmswap_mol=pmswap_mol)
498 nunits=nunits, nunits_tot=nunits_tot, nmol_types=nmol_types, &
499 atom_names=atom_names, mass=mass, mol_type=mol_type)
503 CALL get_mc_par(mc_par(2)%mc_par, dat_file=dat_file(2))
506 ALLOCATE (oldsys(1:2))
507 ALLOCATE (particles_old(1:2))
512 subsys=oldsys(ibox)%subsys)
514 particles=particles_old(ibox)%list)
518 IF (ionode) rand = rng_stream%next()
519 CALL group%bcast(rand, source)
521 IF (rand <= 0.50e0_dp)
THEN
530 CALL get_mc_par(mc_par(remove_box)%mc_par, eta=eta_remove)
531 CALL get_mc_par(mc_par(insert_box)%mc_par, eta=eta_insert)
538 IF (ionode) rand = rng_stream%next()
539 CALL group%bcast(rand, source)
540 DO itype = 1, nmol_types
541 IF (rand < pmswap_mol(itype))
THEN
542 molecule_type = itype
548 moves(molecule_type, insert_box)%moves%swap%attempts = &
549 moves(molecule_type, insert_box)%moves%swap%attempts + 1
553 IF (nchains(molecule_type, remove_box) == 0)
THEN
555 moves(molecule_type, insert_box)%moves%empty = &
556 moves(molecule_type, insert_box)%moves%empty + 1
559 IF (ionode) rand = rng_stream%next()
560 CALL group%bcast(rand, source)
561 imolecule = ceiling(rand*nchains(molecule_type, remove_box))
564 DO itype = 1, nmol_types
565 IF (itype == molecule_type)
THEN
566 start_atom_rem = start_atom_rem + (imolecule - 1)*nunits(itype)
569 start_atom_rem = start_atom_rem + nchains(itype, remove_box)*nunits(itype)
575 DO jbox = 1, remove_box - 1
576 start_mol = start_mol + sum(nchains(:, jbox))
578 end_mol = start_mol + sum(nchains(:, remove_box)) - 1
580 nchains(:, remove_box), nunits, loverlap, mol_type(start_mol:end_mol))
581 IF (loverlap)
CALL cp_abort(__location__, &
582 'CBMC swap move found an overlap in the old remove config')
584 DO jbox = 1, insert_box - 1
585 start_mol = start_mol + sum(nchains(:, jbox))
587 end_mol = start_mol + sum(nchains(:, insert_box)) - 1
589 nchains(:, insert_box), nunits, loverlap, mol_type(start_mol:end_mol))
590 IF (loverlap)
CALL cp_abort(__location__, &
591 'CBMC swap move found an overlap in the old insert config')
596 DEALLOCATE (particles_old)
597 CALL timestop(handle)
602 ins_atoms = nunits_tot(insert_box) + nunits(molecule_type)
603 rem_atoms = nunits_tot(remove_box) - nunits(molecule_type)
606 IF (rem_atoms == 0)
THEN
607 ALLOCATE (remove_coords(1:3, 1:nunits(1)))
608 ALLOCATE (atom_names_remove(1:nunits(1)))
610 ALLOCATE (remove_coords(1:3, 1:rem_atoms))
611 ALLOCATE (atom_names_remove(1:rem_atoms))
613 ALLOCATE (insert_coords(1:3, 1:ins_atoms))
614 ALLOCATE (atom_names_insert(1:ins_atoms))
628 CALL get_cell(cell_remove, abc=abc_remove, deth=vol_remove)
629 CALL get_cell(cell_insert, abc=abc_insert, deth=vol_insert)
634 rand = rng_stream%next()
635 pos_insert(idim) = rand*abc_insert(idim)
638 CALL group%bcast(pos_insert, source)
641 ALLOCATE (r_insert_mol(1:3, 1:nunits(molecule_type)))
644 DO iatom = start_atom_rem, start_atom_rem + nunits(molecule_type) - 1
645 r_insert_mol(1:3, iiatom) = &
646 particles_old(remove_box)%list%els(iatom)%r(1:3)
652 center_of_mass(:), mass(:, molecule_type))
655 displace_molecule(1:3) = pos_insert(1:3) - center_of_mass(1:3)
656 DO iatom = 1, nunits(molecule_type)
657 r_insert_mol(1:3, iatom) = r_insert_mol(1:3, iatom) + &
658 displace_molecule(1:3)
664 IF (sum(nchains(:, insert_box)) == 0)
THEN
665 DO iatom = 1, nunits(molecule_type)
666 insert_coords(1:3, iatom) = r_insert_mol(1:3, iatom)
667 atom_names_insert(iatom) = &
668 particles_old(remove_box)%list%els(start_atom_rem + iatom - 1)%atomic_kind%name
678 DO itype = 1, nmol_types
679 start_atom_ins = start_atom_ins + &
680 nchains(itype, insert_box)*nunits(itype)
681 IF (itype == molecule_type)
EXIT
684 DO iatom = 1, start_atom_ins - 1
685 insert_coords(1:3, iatom) = &
686 particles_old(insert_box)%list%els(iatom)%r(1:3)
687 atom_names_insert(iatom) = &
688 particles_old(insert_box)%list%els(iatom)%atomic_kind%name
691 DO iatom = start_atom_ins, start_atom_ins + nunits(molecule_type) - 1
692 insert_coords(1:3, iatom) = r_insert_mol(1:3, iiatom)
693 atom_names_insert(iatom) = atom_names(iiatom, molecule_type)
696 DO iatom = start_atom_ins + nunits(molecule_type), ins_atoms
697 insert_coords(1:3, iatom) = &
698 particles_old(insert_box)%list%els(iatom - nunits(molecule_type))%r(1:3)
699 atom_names_insert(iatom) = &
700 particles_old(insert_box)%list%els(iatom - nunits(molecule_type))%atomic_kind%name
706 DO jbox = 1, insert_box - 1
707 start_mol = start_mol + sum(nchains(:, jbox))
709 end_mol = start_mol + sum(nchains(:, insert_box)) - 1
714 nchains(molecule_type, insert_box) = nchains(molecule_type, insert_box) + 1
716 CALL get_mc_par(mc_par(insert_box)%mc_par, mc_bias_file=mc_bias_file)
718 abc_insert(:), dat_file(insert_box), nchains(:, insert_box), &
721 CALL get_mc_par(mc_par(insert_box)%mc_par, mc_input_file=mc_input_file)
723 abc_insert(:), dat_file(insert_box), nchains(:, insert_box), &
726 nchains(molecule_type, insert_box) = nchains(molecule_type, insert_box) - 1
731 IF (rem_atoms == 0)
THEN
732 DO iatom = 1, nunits(molecule_type)
733 remove_coords(1:3, iatom) = r_insert_mol(1:3, iatom)
734 atom_names_remove(iatom) = atom_names(iatom, molecule_type)
740 nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) - 1
743 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_bias_file=mc_bias_file)
745 abc_remove(:), dat_file(remove_box), nchains(:, remove_box), &
748 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_input_file=mc_input_file)
750 abc_remove(:), dat_file(remove_box), nchains(:, remove_box), &
755 nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) + 1
758 DO iatom = 1, start_atom_rem - 1
759 remove_coords(1:3, iatom) = &
760 particles_old(remove_box)%list%els(iatom)%r(1:3)
761 atom_names_remove(iatom) = &
762 particles_old(remove_box)%list%els(iatom)%atomic_kind%name
764 DO iatom = start_atom_rem + nunits(molecule_type), nunits_tot(remove_box)
765 remove_coords(1:3, iatom - nunits(molecule_type)) = &
766 particles_old(remove_box)%list%els(iatom)%r(1:3)
767 atom_names_remove(iatom - nunits(molecule_type)) = &
768 particles_old(remove_box)%list%els(iatom)%atomic_kind%name
773 nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) - 1
775 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_bias_file=mc_bias_file)
777 abc_remove(:), dat_file(remove_box), nchains(:, remove_box), &
780 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_input_file=mc_input_file)
782 abc_remove(:), dat_file(remove_box), nchains(:, remove_box), &
785 nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) + 1
791 DEALLOCATE (r_insert_mol)
795 ALLOCATE (test_env(1:2))
797 para_env, dat_file(insert_box))
799 para_env, dat_file(remove_box))
802 ALLOCATE (r_cbmc(1:3, 1:ins_atoms))
803 ALLOCATE (cbmc_energies(1:nswapmoves, 1:2))
805 loverlap_ins = .false.
806 loverlap_rem = .false.
809 IF (rem_atoms == 0)
THEN
811 box_number=remove_box)
816 mol_type=mol_type_test)
821 DO jbox = 1, insert_box - 1
822 start_mol = start_mol + sum(nchains_test(:, jbox))
824 end_mol = start_mol + sum(nchains_test(:, insert_box)) - 1
828 beta, max_val, min_val, exp_max_val, &
829 exp_min_val, nswapmoves, weight_new, start_atom_ins, ins_atoms, nunits(:), &
830 nunits(molecule_type), mass(:, molecule_type), loverlap_ins, bias_energy_new(insert_box), &
831 bias_energy_old(insert_box), ionode, .false., mol_type_test(start_mol:end_mol), &
832 nchains_test(:, insert_box), source, group, rng_stream)
838 bias_energy_new(insert_box) = bias_energy_new(insert_box) + &
839 bias_energy_old(insert_box)
842 beta, max_val, min_val, exp_max_val, &
843 exp_min_val, nswapmoves, weight_new, start_atom_ins, ins_atoms, nunits(:), &
844 nunits(molecule_type), mass(:, molecule_type), loverlap_ins, new_energy(insert_box), &
845 old_energy(insert_box), ionode, .false., mol_type_test(start_mol:end_mol), &
846 nchains_test(:, insert_box), source, group, rng_stream)
852 particles=particles_insert)
854 DO iatom = 1, ins_atoms
855 r_cbmc(1:3, iatom) = particles_insert%els(iatom)%r(1:3)
860 IF (loverlap_ins .OR. loverlap_rem)
THEN
865 DEALLOCATE (insert_coords)
866 DEALLOCATE (remove_coords)
868 DEALLOCATE (cbmc_energies)
870 DEALLOCATE (particles_old)
871 DEALLOCATE (test_env)
872 CALL timestop(handle)
881 particles=particles_insert)
883 DO iatom = 1, ins_atoms
884 particles_insert%els(iatom)%r(1:3) = &
889 moves(molecule_type, insert_box)%moves%grown = &
890 moves(molecule_type, insert_box)%moves%grown + 1
896 ALLOCATE (test_env_bias(1:2))
899 CALL get_mc_par(mc_par(insert_box)%mc_par, mc_input_file=mc_input_file)
901 abc_insert(:), dat_file(insert_box), nchains_test(:, insert_box), &
903 test_env_bias(insert_box)%force_env => test_env(insert_box)%force_env
904 NULLIFY (test_env(insert_box)%force_env)
906 para_env, dat_file(insert_box))
911 potential_energy=new_energy(insert_box))
914 IF (sum(nchains_test(:, remove_box)) == 0)
THEN
915 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_input_file=mc_input_file)
917 abc_remove(:), dat_file(remove_box), nchains_test(:, remove_box), &
919 test_env_bias(remove_box)%force_env => test_env(remove_box)%force_env
920 NULLIFY (test_env(remove_box)%force_env)
922 para_env, dat_file(remove_box))
923 new_energy(remove_box) = 0.0e0_dp
924 bias_energy_new(remove_box) = 0.0e0_dp
926 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_input_file=mc_input_file)
928 abc_remove(:), dat_file(remove_box), nchains_test(:, remove_box), &
930 test_env_bias(remove_box)%force_env => test_env(remove_box)%force_env
931 NULLIFY (test_env(remove_box)%force_env)
933 para_env, dat_file(remove_box))
937 potential_energy=new_energy(remove_box))
941 potential_energy=bias_energy_new(remove_box))
944 IF (sum(nchains_test(:, remove_box)) == 0)
THEN
945 new_energy(remove_box) = 0.0e0_dp
950 potential_energy=new_energy(remove_box))
960 DO jbox = 1, remove_box - 1
961 start_mol = start_mol + sum(nchains(:, jbox))
963 end_mol = start_mol + sum(nchains(:, remove_box)) - 1
966 beta, max_val, min_val, exp_max_val, &
967 exp_min_val, nswapmoves, weight_old, start_atom_rem, nunits_tot(remove_box), &
968 nunits(:), nunits(molecule_type), mass(:, molecule_type), loverlap_rem, rdum, &
969 bias_energy_new(remove_box), ionode, .true., mol_type(start_mol:end_mol), &
970 nchains(:, remove_box), source, group, rng_stream)
973 beta, max_val, min_val, exp_max_val, &
974 exp_min_val, nswapmoves, weight_old, start_atom_rem, nunits_tot(remove_box), &
975 nunits(:), nunits(molecule_type), mass(:, molecule_type), loverlap_rem, rdum, &
976 new_energy(remove_box), ionode, .true., mol_type(start_mol:end_mol), &
977 nchains(:, remove_box), source, group, rng_stream)
983 prefactor = real(nchains(molecule_type, remove_box),
dp)/ &
984 REAL(nchains(molecule_type, insert_box) + 1,
dp)* &
985 vol_insert/vol_remove
989 del_quickstep_energy = (-beta)*(new_energy(insert_box) - &
990 old_energy(insert_box) + new_energy(remove_box) - &
991 old_energy(remove_box) - (bias_energy_new(insert_box) + &
992 bias_energy_new(remove_box) - bias_energy_old(insert_box) &
993 - bias_energy_old(remove_box)))
995 IF (del_quickstep_energy > exp_max_val)
THEN
996 del_quickstep_energy = max_val
997 ELSE IF (del_quickstep_energy < exp_min_val)
THEN
998 del_quickstep_energy = min_val
1000 del_quickstep_energy = exp(del_quickstep_energy)
1002 w = prefactor*del_quickstep_energy*weight_new/weight_old &
1003 *exp(beta*(eta_remove(molecule_type) - eta_insert(molecule_type)))
1006 w = prefactor*weight_new/weight_old &
1007 *exp(beta*(eta_remove(molecule_type) - eta_insert(molecule_type)))
1012 IF (w >= 1.0e0_dp)
THEN
1015 IF (ionode) rand = rng_stream%next()
1016 CALL group%bcast(rand, source)
1025 moves(molecule_type, insert_box)%moves%swap%successes = &
1026 moves(molecule_type, insert_box)%moves%swap%successes + 1
1030 IF (.NOT. lbias)
THEN
1031 new_energy(insert_box) = new_energy(insert_box) + &
1032 old_energy(insert_box)
1037 energy_check(ibox) = energy_check(ibox) + (new_energy(ibox) - &
1039 old_energy(ibox) = new_energy(ibox)
1042 last_bias_energy(ibox) = bias_energy_new(ibox)
1043 bias_energy_old(ibox) = bias_energy_new(ibox)
1052 CALL set_mc_par(mc_par(insert_box)%mc_par, mc_molecule_info=mc_molecule_info_test)
1053 CALL set_mc_par(mc_par(remove_box)%mc_par, mc_molecule_info=mc_molecule_info_test)
1059 particles=particles_insert)
1060 DO ipart = 1, ins_atoms
1061 r_old(1:3, ipart, insert_box) = particles_insert%els(ipart)%r(1:3)
1066 particles=particles_remove)
1067 DO ipart = 1, rem_atoms
1068 r_old(1:3, ipart, remove_box) = particles_remove%els(ipart)%r(1:3)
1073 force_env(insert_box)%force_env => test_env(insert_box)%force_env
1077 force_env(remove_box)%force_env => test_env(remove_box)%force_env
1082 bias_env(insert_box)%force_env => test_env_bias(insert_box)%force_env
1084 bias_env(remove_box)%force_env => test_env_bias(remove_box)%force_env
1085 DEALLOCATE (test_env_bias)
1097 DEALLOCATE (test_env_bias)
1102 DEALLOCATE (insert_coords)
1103 DEALLOCATE (remove_coords)
1104 DEALLOCATE (test_env)
1105 DEALLOCATE (cbmc_energies)
1108 DEALLOCATE (particles_old)
1111 CALL timestop(handle)
1136 nnstep, old_energy, energy_check, r_old, rng_stream)
1139 DIMENSION(:),
POINTER :: mc_par
1141 TYPE(
mc_moves_p_type),
DIMENSION(:, :),
POINTER :: moves, move_updates
1142 INTEGER,
INTENT(IN) :: nnstep
1143 REAL(kind=
dp),
DIMENSION(:),
INTENT(INOUT) :: old_energy, energy_check
1144 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(INOUT) :: r_old
1147 CHARACTER(len=*),
PARAMETER :: routinen =
'mc_ge_volume_move'
1150 CHARACTER(LEN=40),
DIMENSION(1:2) :: dat_file
1151 INTEGER :: cl, end_atom, end_mol, handle, iatom, ibox, imolecule, iside, j, jatom, jbox, &
1152 max_atoms, molecule_index, molecule_type, print_level, source, start_atom, start_mol
1153 INTEGER,
DIMENSION(:),
POINTER :: mol_type, nunits, nunits_tot
1154 INTEGER,
DIMENSION(:, :),
POINTER :: nchains
1156 LOGICAL,
ALLOCATABLE,
DIMENSION(:) :: loverlap
1157 LOGICAL,
DIMENSION(1:2) :: lempty
1158 REAL(
dp),
DIMENSION(:, :),
POINTER :: mass
1159 REAL(kind=
dp) :: beta, prefactor, rand, rmvolume, &
1161 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :, :) :: r
1162 REAL(kind=
dp),
DIMENSION(1:2) :: new_energy, volume_new, volume_old
1163 REAL(kind=
dp),
DIMENSION(1:3) :: center_of_mass, center_of_mass_new, diff
1164 REAL(kind=
dp),
DIMENSION(1:3, 1:2) :: abc, new_cell_length, old_cell_length
1165 REAL(kind=
dp),
DIMENSION(1:3, 1:3, 1:2) :: hmat_test
1166 TYPE(
cell_p_type),
DIMENSION(:),
POINTER :: cell, cell_old, cell_test
1175 CALL timeset(routinen, handle)
1178 NULLIFY (particles_old, cell, oldsys, cell_old, cell_test, subsys)
1181 CALL get_mc_par(mc_par(1)%mc_par, ionode=ionode, source=source, &
1182 group=group, dat_file=dat_file(1), rmvolume=rmvolume, &
1184 mc_molecule_info=mc_molecule_info)
1186 mass=mass, nchains=nchains, nunits=nunits, mol_type=mol_type)
1189 CALL get_mc_par(mc_par(2)%mc_par, dat_file=dat_file(2))
1192 max_atoms = max(nunits_tot(1), nunits_tot(2))
1193 ALLOCATE (r(1:3, max_atoms, 1:2))
1194 ALLOCATE (oldsys(1:2))
1195 ALLOCATE (particles_old(1:2))
1196 ALLOCATE (cell(1:2))
1197 ALLOCATE (cell_test(1:2))
1198 ALLOCATE (cell_old(1:2))
1199 ALLOCATE (loverlap(1:2))
1204 lempty(ibox) = .false.
1205 IF (sum(nchains(:, ibox)) == 0)
THEN
1206 lempty(ibox) = .true.
1212 moves(1, ibox)%moves%volume%attempts = &
1213 moves(1, ibox)%moves%volume%attempts + 1
1214 move_updates(1, ibox)%moves%volume%attempts = &
1215 move_updates(1, ibox)%moves%volume%attempts + 1
1221 subsys=oldsys(ibox)%subsys, cell=cell(ibox)%cell)
1222 CALL get_cell(cell(ibox)%cell, abc=abc(:, ibox))
1223 NULLIFY (cell_old(ibox)%cell)
1225 CALL cell_clone(cell(ibox)%cell, cell_old(ibox)%cell, tag=
"CELL_OLD")
1227 particles=particles_old(ibox)%list)
1230 old_cell_length(1:3, ibox) = abc(1:3, ibox)
1237 DO iatom = 1, nunits_tot(ibox)
1238 r(1:3, iatom, ibox) = particles_old(ibox)%list%els(iatom)%r(1:3)
1244 IF (ionode) rand = rng_stream%next()
1245 CALL group%bcast(rand, source)
1247 vol_dis = rmvolume*(rand - 0.5e0_dp)*2.0e0_dp
1250 IF (old_cell_length(1, 1)*old_cell_length(2, 1)* &
1251 old_cell_length(3, 1) + vol_dis <= (3.0e0_dp/
angstrom)**3)
THEN
1252 cpabort(
'GE_volume moves are trying to make box 1 smaller than 3')
1254 IF (old_cell_length(1, 2)*old_cell_length(2, 2)* &
1255 old_cell_length(3, 2) + vol_dis <= (3.0e0_dp/
angstrom)**3)
THEN
1256 cpabort(
'GE_volume moves are trying to make box 2 smaller than 3')
1260 new_cell_length(iside, 1) = (old_cell_length(1, 1)**3 + &
1261 vol_dis)**(1.0e0_dp/3.0e0_dp)
1262 new_cell_length(iside, 2) = (old_cell_length(1, 2)**3 - &
1263 vol_dis)**(1.0e0_dp/3.0e0_dp)
1268 hmat_test(:, :, ibox) = 0.0e0_dp
1269 hmat_test(1, 1, ibox) = new_cell_length(1, ibox)
1270 hmat_test(2, 2, ibox) = new_cell_length(2, ibox)
1271 hmat_test(3, 3, ibox) = new_cell_length(3, ibox)
1272 NULLIFY (cell_test(ibox)%cell)
1273 CALL cell_create(cell_test(ibox)%cell, hmat=hmat_test(:, :, ibox), &
1274 periodic=cell(ibox)%cell%perd)
1275 CALL force_env_get(force_env(ibox)%force_env, subsys=subsys)
1282 DO iatom = 1, nunits_tot(ibox)
1283 r(1:3, iatom, ibox) = particles_old(ibox)%list%els(iatom)%r(1:3)
1290 DO jbox = 1, ibox - 1
1291 IF (jbox == ibox)
EXIT
1292 molecule_index = molecule_index + sum(nchains(:, jbox))
1294 DO imolecule = 1, sum(nchains(:, ibox))
1295 molecule_type = mol_type(imolecule + molecule_index - 1)
1296 IF (imolecule /= 1)
THEN
1297 start_atom = start_atom + nunits(mol_type(imolecule + molecule_index - 2))
1299 end_atom = start_atom + nunits(molecule_type) - 1
1303 nunits(molecule_type), center_of_mass(:), mass(:, molecule_type))
1307 center_of_mass_new(1:3) = center_of_mass(1:3)* &
1308 new_cell_length(1:3, ibox)/old_cell_length(1:3, ibox)
1310 diff(j) = center_of_mass_new(j) - center_of_mass(j)
1312 DO jatom = start_atom, end_atom
1313 particles_old(ibox)%list%els(jatom)%r(j) = &
1314 particles_old(ibox)%list%els(jatom)%r(j) + diff(j)
1322 DO jbox = 1, ibox - 1
1323 start_mol = start_mol + sum(nchains(:, jbox))
1325 end_mol = start_mol + sum(nchains(:, ibox)) - 1
1327 nchains(:, ibox), nunits, loverlap(ibox), mol_type(start_mol:end_mol), &
1328 cell_length=new_cell_length(:, ibox))
1335 IF (loverlap(ibox)) cycle
1337 IF (lempty(ibox))
THEN
1338 new_energy(ibox) = 0.0e0_dp
1344 potential_energy=new_energy(ibox))
1351 volume_new(ibox) = new_cell_length(1, ibox)* &
1352 new_cell_length(2, ibox)*new_cell_length(3, ibox)
1353 volume_old(ibox) = old_cell_length(1, ibox)* &
1354 old_cell_length(2, ibox)*old_cell_length(3, ibox)
1356 prefactor = (volume_new(1)/volume_old(1))**(sum(nchains(:, 1)))* &
1357 (volume_new(2)/volume_old(2))**(sum(nchains(:, 2)))
1359 IF (loverlap(1) .OR. loverlap(2))
THEN
1362 w = prefactor*exp(-beta* &
1363 (new_energy(1) + new_energy(2) - &
1364 old_energy(1) - old_energy(2)))
1368 IF (w >= 1.0e0_dp)
THEN
1372 IF (ionode) rand = rng_stream%next()
1373 CALL group%bcast(rand, source)
1381 WRITE (cl, *) nnstep, new_cell_length(1, 1)* &
1384 WRITE (cl, *) nnstep, new_energy(1), &
1385 old_energy(1), new_energy(2), old_energy(2)
1386 WRITE (cl, *) prefactor, w
1391 moves(1, ibox)%moves%volume%successes = &
1392 moves(1, ibox)%moves%volume%successes + 1
1393 move_updates(1, ibox)%moves%volume%successes = &
1394 move_updates(1, ibox)%moves%volume%successes + 1
1397 energy_check(ibox) = energy_check(ibox) + (new_energy(ibox) - &
1399 old_energy(ibox) = new_energy(ibox)
1402 DO iatom = 1, nunits_tot(ibox)
1403 r_old(1:3, iatom, ibox) = &
1404 particles_old(ibox)%list%els(iatom)%r(1:3)
1414 WRITE (cl, *) nnstep, new_cell_length(1, 1)* &
1417 WRITE (cl, *) nnstep, new_energy(1), &
1418 old_energy(1), new_energy(2), old_energy(2)
1419 WRITE (cl, *) prefactor, w
1425 CALL force_env_get(force_env(ibox)%force_env, subsys=subsys)
1427 DO iatom = 1, nunits_tot(ibox)
1428 particles_old(ibox)%list%els(iatom)%r(1:3) = r_old(1:3, iatom, ibox)
1441 DEALLOCATE (particles_old)
1443 DEALLOCATE (cell_old)
1444 DEALLOCATE (cell_test)
1445 DEALLOCATE (loverlap)
1448 CALL timestop(handle)