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'
125 REAL(kind=
dp),
PARAMETER :: eps_energies = -1.0e-08_dp
127 INTEGER :: end_mol, handle, ibox, iparticle, &
128 iprint, itype, jbox, nmol_types, &
130 INTEGER,
DIMENSION(:, :),
POINTER :: nchains
131 INTEGER,
DIMENSION(:),
POINTER :: mol_type, nunits, nunits_tot
132 INTEGER,
DIMENSION(1:nboxes) :: diff
133 LOGICAL :: ionode, lbias, loverlap
134 REAL(kind=
dp) :: beta, energies, rand, w
135 REAL(kind=
dp),
DIMENSION(1:nboxes) :: bias_energy_old, new_energy
143 CALL timeset(routinen, handle)
145 NULLIFY (subsys_bias, particles_bias)
148 CALL get_mc_par(mc_par(1)%mc_par, ionode=ionode, lbias=lbias, &
149 beta=beta, diff=diff(1), source=source, group=group, &
151 mc_molecule_info=mc_molecule_info)
153 nchains=nchains, nunits_tot=nunits_tot, nunits=nunits, mol_type=mol_type)
157 CALL get_mc_par(mc_par(ibox)%mc_par, diff=diff(ibox))
162 ALLOCATE (subsys_bias(1:nboxes))
163 ALLOCATE (particles_bias(1:nboxes))
167 moves(1, 1)%moves%Quickstep%attempts = &
168 moves(1, 1)%moves%Quickstep%attempts + 1
173 subsys=subsys(ibox)%subsys)
175 particles=particles(ibox)%list)
181 IF (box_flag(ibox) == 1)
THEN
185 subsys=subsys_bias(ibox)%subsys)
187 particles=particles_bias(ibox)%list)
189 DO iparticle = 1, nunits_tot(ibox)
190 particles(ibox)%list%els(iparticle)%r(1:3) = &
191 particles_bias(ibox)%list%els(iparticle)%r(1:3)
197 potential_energy=new_energy(ibox))
199 IF (.NOT. lreject)
THEN
203 potential_energy=new_energy(ibox))
207 new_energy(ibox) = old_energy(ibox)
216 IF (mod(nnstep, iprint) == 0)
THEN
218 IF (sum(nchains(:, ibox)) == 0)
THEN
219 WRITE (diff(ibox), *) nnstep
220 WRITE (diff(ibox), *) nchains(:, ibox)
222 WRITE (diff(ibox), *) nnstep
224 particles(ibox)%list%els, &
232 IF (.NOT. lreject)
THEN
237 IF (sum(nchains(:, ibox)) /= 0)
THEN
240 DO jbox = 1, ibox - 1
241 start_mol = start_mol + sum(nchains(:, jbox))
243 end_mol = start_mol + sum(nchains(:, ibox)) - 1
245 nchains(:, ibox), nunits(:), loverlap, mol_type(start_mol:end_mol))
247 cpabort(
'Quickstep move found an overlap in the old config')
250 bias_energy_old(ibox) = last_bias_energy(ibox)
253 energies = -beta*((sum(new_energy(:)) - sum(bias_energy_new(:))) &
254 - (sum(old_energy(:)) - sum(bias_energy_old(:))))
257 IF (energies >= eps_energies)
THEN
259 ELSE IF (energies <= -500.0_dp)
THEN
267 WRITE (diff(ibox), *) nnstep, new_energy(ibox) - &
269 bias_energy_new(ibox) - bias_energy_old(ibox)
273 energies = -beta*(sum(new_energy(:)) - sum(old_energy(:)))
275 IF (energies >= 0.0_dp)
THEN
277 ELSE IF (energies <= -500.0_dp)
THEN
286 IF (w >= 1.0e0_dp)
THEN
290 IF (ionode) rand = rng_stream%next()
291 CALL group%bcast(rand, source)
297 moves(1, 1)%moves%Quickstep%successes = &
298 moves(1, 1)%moves%Quickstep%successes + 1
302 IF (.NOT. lbias)
THEN
303 DO itype = 1, nmol_types
313 DO itype = 1, nmol_types
324 energy_check(ibox) = energy_check(ibox) + &
325 (new_energy(ibox) - old_energy(ibox))
326 old_energy(ibox) = new_energy(ibox)
332 last_bias_energy(ibox) = bias_energy_new(ibox)
338 IF (nunits_tot(ibox) /= 0)
THEN
339 DO iparticle = 1, nunits_tot(ibox)
340 r_old(1:3, iparticle, ibox) = &
341 particles(ibox)%list%els(iparticle)%r(1:3)
350 DO itype = 1, nmol_types
353 IF (.NOT. lbias)
THEN
362 IF (.NOT. ionode) r_old(:, :, :) = 0.0e0_dp
366 CALL group%bcast(r_old, source)
369 DO iparticle = 1, nunits_tot(ibox)
370 particles(ibox)%list%els(iparticle)%r(1:3) = &
371 r_old(1:3, iparticle, ibox)
372 IF (lbias .AND. box_flag(ibox) == 1)
THEN
373 particles_bias(ibox)%list%els(iparticle)%r(1:3) = &
374 r_old(1:3, iparticle, ibox)
382 bias_energy_new(ibox) = last_bias_energy(ibox)
391 particles=particles(ibox)%list)
392 IF (lbias .AND. box_flag(ibox) == 1)
THEN
394 particles=particles_bias(ibox)%list)
399 DEALLOCATE (subsys_bias)
400 DEALLOCATE (particles_bias)
403 CALL timestop(handle)
429 energy_check, r_old, old_energy, input_declaration, &
430 para_env, bias_energy_old, last_bias_energy, &
434 DIMENSION(:),
POINTER :: mc_par
437 REAL(kind=
dp),
DIMENSION(1:2),
INTENT(INOUT) :: energy_check
438 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(INOUT) :: r_old
439 REAL(kind=
dp),
DIMENSION(1:2),
INTENT(INOUT) :: old_energy
442 REAL(kind=
dp),
DIMENSION(1:2),
INTENT(INOUT) :: bias_energy_old, last_bias_energy
445 CHARACTER(len=*),
PARAMETER :: routinen =
'mc_ge_swap_move'
447 CHARACTER(default_string_length),
ALLOCATABLE, &
448 DIMENSION(:) :: atom_names_insert, atom_names_remove
449 CHARACTER(default_string_length), &
450 DIMENSION(:, :),
POINTER :: atom_names
452 CHARACTER(LEN=40),
DIMENSION(1:2) :: dat_file
453 INTEGER :: end_mol, handle, iatom, ibox, idim, iiatom, imolecule, ins_atoms, insert_box, &
454 ipart, itype, jbox, molecule_type, nmol_types, nswapmoves, print_level, rem_atoms, &
455 remove_box, source, start_atom_ins, start_atom_rem, start_mol
456 INTEGER,
DIMENSION(:),
POINTER :: mol_type, mol_type_test, nunits, &
458 INTEGER,
DIMENSION(:, :),
POINTER :: nchains, nchains_test
459 LOGICAL :: ionode, lbias, loverlap, loverlap_ins, &
461 REAL(
dp),
DIMENSION(:),
POINTER :: eta_insert, eta_remove, pmswap_mol
462 REAL(
dp),
DIMENSION(:, :),
POINTER :: insert_coords, remove_coords
463 REAL(kind=
dp) :: beta, del_quickstep_energy, exp_max_val, exp_min_val, max_val, min_val, &
464 prefactor, rand, rdum, vol_insert, vol_remove, w, weight_new, weight_old
465 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: cbmc_energies, r_cbmc, r_insert_mol
466 REAL(kind=
dp),
DIMENSION(1:2) :: bias_energy_new, new_energy
467 REAL(kind=
dp),
DIMENSION(1:3) :: abc_insert, abc_remove, center_of_mass, &
468 displace_molecule, pos_insert
469 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: mass
470 TYPE(
cell_type),
POINTER :: cell_insert, cell_remove
482 CALL timeset(routinen, handle)
488 NULLIFY (particles_old, mol_type, mol_type_test, mc_input_file, mc_bias_file)
489 NULLIFY (oldsys, atom_names, pmswap_mol, insert_coords, remove_coords)
490 NULLIFY (eta_insert, eta_remove)
493 CALL get_mc_par(mc_par(1)%mc_par, ionode=ionode, beta=beta, &
494 max_val=max_val, min_val=min_val, exp_max_val=exp_max_val, &
495 exp_min_val=exp_min_val, nswapmoves=nswapmoves, group=group, source=source, &
497 mc_molecule_info=mc_molecule_info, pmswap_mol=pmswap_mol)
499 nunits=nunits, nunits_tot=nunits_tot, nmol_types=nmol_types, &
500 atom_names=atom_names, mass=mass, mol_type=mol_type)
504 CALL get_mc_par(mc_par(2)%mc_par, dat_file=dat_file(2))
507 ALLOCATE (oldsys(1:2))
508 ALLOCATE (particles_old(1:2))
513 subsys=oldsys(ibox)%subsys)
515 particles=particles_old(ibox)%list)
519 IF (ionode) rand = rng_stream%next()
520 CALL group%bcast(rand, source)
522 IF (rand <= 0.50e0_dp)
THEN
531 CALL get_mc_par(mc_par(remove_box)%mc_par, eta=eta_remove)
532 CALL get_mc_par(mc_par(insert_box)%mc_par, eta=eta_insert)
539 IF (ionode) rand = rng_stream%next()
540 CALL group%bcast(rand, source)
541 DO itype = 1, nmol_types
542 IF (rand < pmswap_mol(itype))
THEN
543 molecule_type = itype
549 moves(molecule_type, insert_box)%moves%swap%attempts = &
550 moves(molecule_type, insert_box)%moves%swap%attempts + 1
554 IF (nchains(molecule_type, remove_box) == 0)
THEN
556 moves(molecule_type, insert_box)%moves%empty = &
557 moves(molecule_type, insert_box)%moves%empty + 1
560 IF (ionode) rand = rng_stream%next()
561 CALL group%bcast(rand, source)
562 imolecule = ceiling(rand*nchains(molecule_type, remove_box))
565 DO itype = 1, nmol_types
566 IF (itype == molecule_type)
THEN
567 start_atom_rem = start_atom_rem + (imolecule - 1)*nunits(itype)
570 start_atom_rem = start_atom_rem + nchains(itype, remove_box)*nunits(itype)
576 DO jbox = 1, remove_box - 1
577 start_mol = start_mol + sum(nchains(:, jbox))
579 end_mol = start_mol + sum(nchains(:, remove_box)) - 1
581 nchains(:, remove_box), nunits, loverlap, mol_type(start_mol:end_mol))
582 IF (loverlap)
CALL cp_abort(__location__, &
583 'CBMC swap move found an overlap in the old remove config')
585 DO jbox = 1, insert_box - 1
586 start_mol = start_mol + sum(nchains(:, jbox))
588 end_mol = start_mol + sum(nchains(:, insert_box)) - 1
590 nchains(:, insert_box), nunits, loverlap, mol_type(start_mol:end_mol))
591 IF (loverlap)
CALL cp_abort(__location__, &
592 'CBMC swap move found an overlap in the old insert config')
597 DEALLOCATE (particles_old)
598 CALL timestop(handle)
603 ins_atoms = nunits_tot(insert_box) + nunits(molecule_type)
604 rem_atoms = nunits_tot(remove_box) - nunits(molecule_type)
607 IF (rem_atoms == 0)
THEN
608 ALLOCATE (remove_coords(1:3, 1:nunits(1)))
609 ALLOCATE (atom_names_remove(1:nunits(1)))
611 ALLOCATE (remove_coords(1:3, 1:rem_atoms))
612 ALLOCATE (atom_names_remove(1:rem_atoms))
614 ALLOCATE (insert_coords(1:3, 1:ins_atoms))
615 ALLOCATE (atom_names_insert(1:ins_atoms))
629 CALL get_cell(cell_remove, abc=abc_remove, deth=vol_remove)
630 CALL get_cell(cell_insert, abc=abc_insert, deth=vol_insert)
635 rand = rng_stream%next()
636 pos_insert(idim) = rand*abc_insert(idim)
639 CALL group%bcast(pos_insert, source)
642 ALLOCATE (r_insert_mol(1:3, 1:nunits(molecule_type)))
645 DO iatom = start_atom_rem, start_atom_rem + nunits(molecule_type) - 1
646 r_insert_mol(1:3, iiatom) = &
647 particles_old(remove_box)%list%els(iatom)%r(1:3)
653 center_of_mass(:), mass(:, molecule_type))
656 displace_molecule(1:3) = pos_insert(1:3) - center_of_mass(1:3)
657 DO iatom = 1, nunits(molecule_type)
658 r_insert_mol(1:3, iatom) = r_insert_mol(1:3, iatom) + &
659 displace_molecule(1:3)
665 IF (sum(nchains(:, insert_box)) == 0)
THEN
666 DO iatom = 1, nunits(molecule_type)
667 insert_coords(1:3, iatom) = r_insert_mol(1:3, iatom)
668 atom_names_insert(iatom) = &
669 particles_old(remove_box)%list%els(start_atom_rem + iatom - 1)%atomic_kind%name
679 DO itype = 1, nmol_types
680 start_atom_ins = start_atom_ins + &
681 nchains(itype, insert_box)*nunits(itype)
682 IF (itype == molecule_type)
EXIT
685 DO iatom = 1, start_atom_ins - 1
686 insert_coords(1:3, iatom) = &
687 particles_old(insert_box)%list%els(iatom)%r(1:3)
688 atom_names_insert(iatom) = &
689 particles_old(insert_box)%list%els(iatom)%atomic_kind%name
692 DO iatom = start_atom_ins, start_atom_ins + nunits(molecule_type) - 1
693 insert_coords(1:3, iatom) = r_insert_mol(1:3, iiatom)
694 atom_names_insert(iatom) = atom_names(iiatom, molecule_type)
697 DO iatom = start_atom_ins + nunits(molecule_type), ins_atoms
698 insert_coords(1:3, iatom) = &
699 particles_old(insert_box)%list%els(iatom - nunits(molecule_type))%r(1:3)
700 atom_names_insert(iatom) = &
701 particles_old(insert_box)%list%els(iatom - nunits(molecule_type))%atomic_kind%name
707 DO jbox = 1, insert_box - 1
708 start_mol = start_mol + sum(nchains(:, jbox))
710 end_mol = start_mol + sum(nchains(:, insert_box)) - 1
715 nchains(molecule_type, insert_box) = nchains(molecule_type, insert_box) + 1
717 CALL get_mc_par(mc_par(insert_box)%mc_par, mc_bias_file=mc_bias_file)
719 abc_insert(:), dat_file(insert_box), nchains(:, insert_box), &
722 CALL get_mc_par(mc_par(insert_box)%mc_par, mc_input_file=mc_input_file)
724 abc_insert(:), dat_file(insert_box), nchains(:, insert_box), &
727 nchains(molecule_type, insert_box) = nchains(molecule_type, insert_box) - 1
732 IF (rem_atoms == 0)
THEN
733 DO iatom = 1, nunits(molecule_type)
734 remove_coords(1:3, iatom) = r_insert_mol(1:3, iatom)
735 atom_names_remove(iatom) = atom_names(iatom, molecule_type)
741 nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) - 1
744 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_bias_file=mc_bias_file)
746 abc_remove(:), dat_file(remove_box), nchains(:, remove_box), &
749 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_input_file=mc_input_file)
751 abc_remove(:), dat_file(remove_box), nchains(:, remove_box), &
756 nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) + 1
759 DO iatom = 1, start_atom_rem - 1
760 remove_coords(1:3, iatom) = &
761 particles_old(remove_box)%list%els(iatom)%r(1:3)
762 atom_names_remove(iatom) = &
763 particles_old(remove_box)%list%els(iatom)%atomic_kind%name
765 DO iatom = start_atom_rem + nunits(molecule_type), nunits_tot(remove_box)
766 remove_coords(1:3, iatom - nunits(molecule_type)) = &
767 particles_old(remove_box)%list%els(iatom)%r(1:3)
768 atom_names_remove(iatom - nunits(molecule_type)) = &
769 particles_old(remove_box)%list%els(iatom)%atomic_kind%name
774 nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) - 1
776 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_bias_file=mc_bias_file)
778 abc_remove(:), dat_file(remove_box), nchains(:, remove_box), &
781 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_input_file=mc_input_file)
783 abc_remove(:), dat_file(remove_box), nchains(:, remove_box), &
786 nchains(molecule_type, remove_box) = nchains(molecule_type, remove_box) + 1
792 DEALLOCATE (r_insert_mol)
796 ALLOCATE (test_env(1:2))
798 para_env, dat_file(insert_box))
800 para_env, dat_file(remove_box))
803 ALLOCATE (r_cbmc(1:3, 1:ins_atoms))
804 ALLOCATE (cbmc_energies(1:nswapmoves, 1:2))
806 loverlap_ins = .false.
807 loverlap_rem = .false.
810 IF (rem_atoms == 0)
THEN
812 box_number=remove_box)
817 mol_type=mol_type_test)
822 DO jbox = 1, insert_box - 1
823 start_mol = start_mol + sum(nchains_test(:, jbox))
825 end_mol = start_mol + sum(nchains_test(:, insert_box)) - 1
829 beta, max_val, min_val, exp_max_val, &
830 exp_min_val, nswapmoves, weight_new, start_atom_ins, ins_atoms, nunits(:), &
831 nunits(molecule_type), mass(:, molecule_type), loverlap_ins, bias_energy_new(insert_box), &
832 bias_energy_old(insert_box), ionode, .false., mol_type_test(start_mol:end_mol), &
833 nchains_test(:, insert_box), source, group, rng_stream)
839 bias_energy_new(insert_box) = bias_energy_new(insert_box) + &
840 bias_energy_old(insert_box)
843 beta, max_val, min_val, exp_max_val, &
844 exp_min_val, nswapmoves, weight_new, start_atom_ins, ins_atoms, nunits(:), &
845 nunits(molecule_type), mass(:, molecule_type), loverlap_ins, new_energy(insert_box), &
846 old_energy(insert_box), ionode, .false., mol_type_test(start_mol:end_mol), &
847 nchains_test(:, insert_box), source, group, rng_stream)
853 particles=particles_insert)
855 DO iatom = 1, ins_atoms
856 r_cbmc(1:3, iatom) = particles_insert%els(iatom)%r(1:3)
861 IF (loverlap_ins .OR. loverlap_rem)
THEN
866 DEALLOCATE (insert_coords)
867 DEALLOCATE (remove_coords)
869 DEALLOCATE (cbmc_energies)
871 DEALLOCATE (particles_old)
872 DEALLOCATE (test_env)
873 CALL timestop(handle)
882 particles=particles_insert)
884 DO iatom = 1, ins_atoms
885 particles_insert%els(iatom)%r(1:3) = &
890 moves(molecule_type, insert_box)%moves%grown = &
891 moves(molecule_type, insert_box)%moves%grown + 1
897 ALLOCATE (test_env_bias(1:2))
900 CALL get_mc_par(mc_par(insert_box)%mc_par, mc_input_file=mc_input_file)
902 abc_insert(:), dat_file(insert_box), nchains_test(:, insert_box), &
904 test_env_bias(insert_box)%force_env => test_env(insert_box)%force_env
905 NULLIFY (test_env(insert_box)%force_env)
907 para_env, dat_file(insert_box))
912 potential_energy=new_energy(insert_box))
915 IF (sum(nchains_test(:, remove_box)) == 0)
THEN
916 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_input_file=mc_input_file)
918 abc_remove(:), dat_file(remove_box), nchains_test(:, remove_box), &
920 test_env_bias(remove_box)%force_env => test_env(remove_box)%force_env
921 NULLIFY (test_env(remove_box)%force_env)
923 para_env, dat_file(remove_box))
924 new_energy(remove_box) = 0.0e0_dp
925 bias_energy_new(remove_box) = 0.0e0_dp
927 CALL get_mc_par(mc_par(remove_box)%mc_par, mc_input_file=mc_input_file)
929 abc_remove(:), dat_file(remove_box), nchains_test(:, remove_box), &
931 test_env_bias(remove_box)%force_env => test_env(remove_box)%force_env
932 NULLIFY (test_env(remove_box)%force_env)
934 para_env, dat_file(remove_box))
938 potential_energy=new_energy(remove_box))
942 potential_energy=bias_energy_new(remove_box))
945 IF (sum(nchains_test(:, remove_box)) == 0)
THEN
946 new_energy(remove_box) = 0.0e0_dp
951 potential_energy=new_energy(remove_box))
961 DO jbox = 1, remove_box - 1
962 start_mol = start_mol + sum(nchains(:, jbox))
964 end_mol = start_mol + sum(nchains(:, remove_box)) - 1
967 beta, max_val, min_val, exp_max_val, &
968 exp_min_val, nswapmoves, weight_old, start_atom_rem, nunits_tot(remove_box), &
969 nunits(:), nunits(molecule_type), mass(:, molecule_type), loverlap_rem, rdum, &
970 bias_energy_new(remove_box), ionode, .true., mol_type(start_mol:end_mol), &
971 nchains(:, remove_box), source, group, rng_stream)
974 beta, max_val, min_val, exp_max_val, &
975 exp_min_val, nswapmoves, weight_old, start_atom_rem, nunits_tot(remove_box), &
976 nunits(:), nunits(molecule_type), mass(:, molecule_type), loverlap_rem, rdum, &
977 new_energy(remove_box), ionode, .true., mol_type(start_mol:end_mol), &
978 nchains(:, remove_box), source, group, rng_stream)
984 prefactor = real(nchains(molecule_type, remove_box),
dp)/ &
985 REAL(nchains(molecule_type, insert_box) + 1,
dp)* &
986 vol_insert/vol_remove
990 del_quickstep_energy = (-beta)*(new_energy(insert_box) - &
991 old_energy(insert_box) + new_energy(remove_box) - &
992 old_energy(remove_box) - (bias_energy_new(insert_box) + &
993 bias_energy_new(remove_box) - bias_energy_old(insert_box) &
994 - bias_energy_old(remove_box)))
996 IF (del_quickstep_energy > exp_max_val)
THEN
997 del_quickstep_energy = max_val
998 ELSE IF (del_quickstep_energy < exp_min_val)
THEN
999 del_quickstep_energy = min_val
1001 del_quickstep_energy = exp(del_quickstep_energy)
1003 w = prefactor*del_quickstep_energy*weight_new/weight_old &
1004 *exp(beta*(eta_remove(molecule_type) - eta_insert(molecule_type)))
1007 w = prefactor*weight_new/weight_old &
1008 *exp(beta*(eta_remove(molecule_type) - eta_insert(molecule_type)))
1013 IF (w >= 1.0e0_dp)
THEN
1016 IF (ionode) rand = rng_stream%next()
1017 CALL group%bcast(rand, source)
1026 moves(molecule_type, insert_box)%moves%swap%successes = &
1027 moves(molecule_type, insert_box)%moves%swap%successes + 1
1031 IF (.NOT. lbias)
THEN
1032 new_energy(insert_box) = new_energy(insert_box) + &
1033 old_energy(insert_box)
1038 energy_check(ibox) = energy_check(ibox) + (new_energy(ibox) - &
1040 old_energy(ibox) = new_energy(ibox)
1043 last_bias_energy(ibox) = bias_energy_new(ibox)
1044 bias_energy_old(ibox) = bias_energy_new(ibox)
1053 CALL set_mc_par(mc_par(insert_box)%mc_par, mc_molecule_info=mc_molecule_info_test)
1054 CALL set_mc_par(mc_par(remove_box)%mc_par, mc_molecule_info=mc_molecule_info_test)
1060 particles=particles_insert)
1061 DO ipart = 1, ins_atoms
1062 r_old(1:3, ipart, insert_box) = particles_insert%els(ipart)%r(1:3)
1067 particles=particles_remove)
1068 DO ipart = 1, rem_atoms
1069 r_old(1:3, ipart, remove_box) = particles_remove%els(ipart)%r(1:3)
1074 force_env(insert_box)%force_env => test_env(insert_box)%force_env
1078 force_env(remove_box)%force_env => test_env(remove_box)%force_env
1083 bias_env(insert_box)%force_env => test_env_bias(insert_box)%force_env
1085 bias_env(remove_box)%force_env => test_env_bias(remove_box)%force_env
1086 DEALLOCATE (test_env_bias)
1098 DEALLOCATE (test_env_bias)
1103 DEALLOCATE (insert_coords)
1104 DEALLOCATE (remove_coords)
1105 DEALLOCATE (test_env)
1106 DEALLOCATE (cbmc_energies)
1109 DEALLOCATE (particles_old)
1112 CALL timestop(handle)
1137 nnstep, old_energy, energy_check, r_old, rng_stream)
1140 DIMENSION(:),
POINTER :: mc_par
1142 TYPE(
mc_moves_p_type),
DIMENSION(:, :),
POINTER :: moves, move_updates
1143 INTEGER,
INTENT(IN) :: nnstep
1144 REAL(kind=
dp),
DIMENSION(:),
INTENT(INOUT) :: old_energy, energy_check
1145 REAL(kind=
dp),
DIMENSION(:, :, :),
INTENT(INOUT) :: r_old
1148 CHARACTER(len=*),
PARAMETER :: routinen =
'mc_ge_volume_move'
1151 CHARACTER(LEN=40),
DIMENSION(1:2) :: dat_file
1152 INTEGER :: cl, end_atom, end_mol, handle, iatom, ibox, imolecule, iside, j, jatom, jbox, &
1153 max_atoms, molecule_index, molecule_type, print_level, source, start_atom, start_mol
1154 INTEGER,
DIMENSION(:),
POINTER :: mol_type, nunits, nunits_tot
1155 INTEGER,
DIMENSION(:, :),
POINTER :: nchains
1157 LOGICAL,
ALLOCATABLE,
DIMENSION(:) :: loverlap
1158 LOGICAL,
DIMENSION(1:2) :: lempty
1159 REAL(
dp),
DIMENSION(:, :),
POINTER :: mass
1160 REAL(kind=
dp) :: beta, prefactor, rand, rmvolume, &
1162 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :, :) :: r
1163 REAL(kind=
dp),
DIMENSION(1:2) :: new_energy, volume_new, volume_old
1164 REAL(kind=
dp),
DIMENSION(1:3) :: center_of_mass, center_of_mass_new, diff
1165 REAL(kind=
dp),
DIMENSION(1:3, 1:2) :: abc, new_cell_length, old_cell_length
1166 REAL(kind=
dp),
DIMENSION(1:3, 1:3, 1:2) :: hmat_test
1167 TYPE(
cell_p_type),
DIMENSION(:),
POINTER :: cell, cell_old, cell_test
1176 CALL timeset(routinen, handle)
1179 NULLIFY (particles_old, cell, oldsys, cell_old, cell_test, subsys)
1182 CALL get_mc_par(mc_par(1)%mc_par, ionode=ionode, source=source, &
1183 group=group, dat_file=dat_file(1), rmvolume=rmvolume, &
1185 mc_molecule_info=mc_molecule_info)
1187 mass=mass, nchains=nchains, nunits=nunits, mol_type=mol_type)
1190 CALL get_mc_par(mc_par(2)%mc_par, dat_file=dat_file(2))
1193 max_atoms = max(nunits_tot(1), nunits_tot(2))
1194 ALLOCATE (r(1:3, max_atoms, 1:2))
1195 ALLOCATE (oldsys(1:2))
1196 ALLOCATE (particles_old(1:2))
1197 ALLOCATE (cell(1:2))
1198 ALLOCATE (cell_test(1:2))
1199 ALLOCATE (cell_old(1:2))
1200 ALLOCATE (loverlap(1:2))
1205 lempty(ibox) = .false.
1206 IF (sum(nchains(:, ibox)) == 0)
THEN
1207 lempty(ibox) = .true.
1213 moves(1, ibox)%moves%volume%attempts = &
1214 moves(1, ibox)%moves%volume%attempts + 1
1215 move_updates(1, ibox)%moves%volume%attempts = &
1216 move_updates(1, ibox)%moves%volume%attempts + 1
1222 subsys=oldsys(ibox)%subsys, cell=cell(ibox)%cell)
1223 CALL get_cell(cell(ibox)%cell, abc=abc(:, ibox))
1224 NULLIFY (cell_old(ibox)%cell)
1226 CALL cell_clone(cell(ibox)%cell, cell_old(ibox)%cell, tag=
"CELL_OLD")
1228 particles=particles_old(ibox)%list)
1231 old_cell_length(1:3, ibox) = abc(1:3, ibox)
1238 DO iatom = 1, nunits_tot(ibox)
1239 r(1:3, iatom, ibox) = particles_old(ibox)%list%els(iatom)%r(1:3)
1245 IF (ionode) rand = rng_stream%next()
1246 CALL group%bcast(rand, source)
1248 vol_dis = rmvolume*(rand - 0.5e0_dp)*2.0e0_dp
1251 IF (old_cell_length(1, 1)*old_cell_length(2, 1)* &
1252 old_cell_length(3, 1) + vol_dis <= (3.0e0_dp/
angstrom)**3)
THEN
1253 cpabort(
'GE_volume moves are trying to make box 1 smaller than 3')
1255 IF (old_cell_length(1, 2)*old_cell_length(2, 2)* &
1256 old_cell_length(3, 2) + vol_dis <= (3.0e0_dp/
angstrom)**3)
THEN
1257 cpabort(
'GE_volume moves are trying to make box 2 smaller than 3')
1261 new_cell_length(iside, 1) = (old_cell_length(1, 1)**3 + &
1262 vol_dis)**(1.0e0_dp/3.0e0_dp)
1263 new_cell_length(iside, 2) = (old_cell_length(1, 2)**3 - &
1264 vol_dis)**(1.0e0_dp/3.0e0_dp)
1269 hmat_test(:, :, ibox) = 0.0e0_dp
1270 hmat_test(1, 1, ibox) = new_cell_length(1, ibox)
1271 hmat_test(2, 2, ibox) = new_cell_length(2, ibox)
1272 hmat_test(3, 3, ibox) = new_cell_length(3, ibox)
1273 NULLIFY (cell_test(ibox)%cell)
1274 CALL cell_create(cell_test(ibox)%cell, hmat=hmat_test(:, :, ibox), &
1275 periodic=cell(ibox)%cell%perd)
1276 CALL force_env_get(force_env(ibox)%force_env, subsys=subsys)
1283 DO iatom = 1, nunits_tot(ibox)
1284 r(1:3, iatom, ibox) = particles_old(ibox)%list%els(iatom)%r(1:3)
1291 DO jbox = 1, ibox - 1
1292 IF (jbox == ibox)
EXIT
1293 molecule_index = molecule_index + sum(nchains(:, jbox))
1295 DO imolecule = 1, sum(nchains(:, ibox))
1296 molecule_type = mol_type(imolecule + molecule_index - 1)
1297 IF (imolecule /= 1)
THEN
1298 start_atom = start_atom + nunits(mol_type(imolecule + molecule_index - 2))
1300 end_atom = start_atom + nunits(molecule_type) - 1
1304 nunits(molecule_type), center_of_mass(:), mass(:, molecule_type))
1308 center_of_mass_new(1:3) = center_of_mass(1:3)* &
1309 new_cell_length(1:3, ibox)/old_cell_length(1:3, ibox)
1311 diff(j) = center_of_mass_new(j) - center_of_mass(j)
1313 DO jatom = start_atom, end_atom
1314 particles_old(ibox)%list%els(jatom)%r(j) = &
1315 particles_old(ibox)%list%els(jatom)%r(j) + diff(j)
1323 DO jbox = 1, ibox - 1
1324 start_mol = start_mol + sum(nchains(:, jbox))
1326 end_mol = start_mol + sum(nchains(:, ibox)) - 1
1328 nchains(:, ibox), nunits, loverlap(ibox), mol_type(start_mol:end_mol), &
1329 cell_length=new_cell_length(:, ibox))
1336 IF (loverlap(ibox)) cycle
1338 IF (lempty(ibox))
THEN
1339 new_energy(ibox) = 0.0e0_dp
1345 potential_energy=new_energy(ibox))
1352 volume_new(ibox) = new_cell_length(1, ibox)* &
1353 new_cell_length(2, ibox)*new_cell_length(3, ibox)
1354 volume_old(ibox) = old_cell_length(1, ibox)* &
1355 old_cell_length(2, ibox)*old_cell_length(3, ibox)
1357 prefactor = (volume_new(1)/volume_old(1))**(sum(nchains(:, 1)))* &
1358 (volume_new(2)/volume_old(2))**(sum(nchains(:, 2)))
1360 IF (loverlap(1) .OR. loverlap(2))
THEN
1363 w = prefactor*exp(-beta* &
1364 (new_energy(1) + new_energy(2) - &
1365 old_energy(1) - old_energy(2)))
1369 IF (w >= 1.0e0_dp)
THEN
1373 IF (ionode) rand = rng_stream%next()
1374 CALL group%bcast(rand, source)
1382 WRITE (cl, *) nnstep, new_cell_length(1, 1)* &
1385 WRITE (cl, *) nnstep, new_energy(1), &
1386 old_energy(1), new_energy(2), old_energy(2)
1387 WRITE (cl, *) prefactor, w
1392 moves(1, ibox)%moves%volume%successes = &
1393 moves(1, ibox)%moves%volume%successes + 1
1394 move_updates(1, ibox)%moves%volume%successes = &
1395 move_updates(1, ibox)%moves%volume%successes + 1
1398 energy_check(ibox) = energy_check(ibox) + (new_energy(ibox) - &
1400 old_energy(ibox) = new_energy(ibox)
1403 DO iatom = 1, nunits_tot(ibox)
1404 r_old(1:3, iatom, ibox) = &
1405 particles_old(ibox)%list%els(iatom)%r(1:3)
1415 WRITE (cl, *) nnstep, new_cell_length(1, 1)* &
1418 WRITE (cl, *) nnstep, new_energy(1), &
1419 old_energy(1), new_energy(2), old_energy(2)
1420 WRITE (cl, *) prefactor, w
1426 CALL force_env_get(force_env(ibox)%force_env, subsys=subsys)
1428 DO iatom = 1, nunits_tot(ibox)
1429 particles_old(ibox)%list%els(iatom)%r(1:3) = r_old(1:3, iatom, ibox)
1442 DEALLOCATE (particles_old)
1444 DEALLOCATE (cell_old)
1445 DEALLOCATE (cell_test)
1446 DEALLOCATE (loverlap)
1449 CALL timestop(handle)