This function read a .mmp file (revision 2 and 3) are supported and initialize all the quantities need to describe the environment within this library.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | input_file |
name of the input file |
||
type(ommp_system), | intent(inout) | :: | sys_obj |
System data structure to be initialized |
subroutine mmpol_init_from_mmp(input_file, sys_obj)
!! This function read a .mmp file (revision 2 and 3) are supported
!! and initialize all the quantities need to describe the environment
!! within this library.
use mod_mmpol, only: mmpol_prepare, mmpol_init
use mod_electrostatics, only: set_screening_parameters
use mod_memory, only: ip, rp, mfree, mallocate, memory_init
use mod_io, only: iof_mmpinp
use mod_adjacency_mat, only: adj_mat_from_conn
use mod_utils, only: skip_lines
use mod_constants, only: angstrom2au, OMMP_VERBOSE_DEBUG
use mod_constants, only: mscale_wang_al, &
pscale_wang_al, &
dscale_wang_al, &
uscale_wang_al, &
mscale_wang_dl, &
pscale_wang_dl, &
dscale_wang_dl, &
uscale_wang_dl, &
mscale_amoeba, &
pscale_amoeba, &
dscale_amoeba, &
uscale_amoeba, &
pscale_intra_amoeba, &
thole_scale_wang_dl, &
thole_scale_wang_al
implicit none
type(ommp_system), intent(inout) :: sys_obj
!! System data structure to be initialized
character(len=*), intent(in) :: input_file
!! name of the input file
! read the input for the mmpol calculation and process it.
integer(ip) :: input_revision
integer(ip) :: my_mm_atoms, my_pol_atoms, my_ff_type, my_ff_rules
integer(ip) :: my_ld_cart
integer(ip) :: i, ist
real(rp), allocatable :: my_pol(:), my_cmm(:,:), my_q(:,:)
integer(ip), allocatable :: pol_atoms_list(:), my_ip11(:,:)
integer(ip), parameter :: maxn12 = 8
!! maximum number of neighbour atoms
integer(ip), parameter :: maxpgp = 120
!! maximum number of members for the same polarization group
real(rp), parameter :: thres = 1e-8
!! Threshold used to decide if a polarizability is zero
! TODO why we do not use eps_rp directly?
integer(ip), allocatable :: i12(:,:)
character(len=OMMP_STR_CHAR_MAX) :: msg
logical :: fex
call time_push()
write(msg, "(A)") "Reading MMP file: "//input_file(1:len(trim(input_file)))
call ommp_message(msg, OMMP_VERBOSE_DEBUG)
inquire(file=input_file(1:len(trim(input_file))), exist=fex)
if(.not. fex) then
call fatal_error("Input file '"//&
&input_file(1:len(trim(input_file)))//"' does not exist.")
end if
open(unit=iof_mmpinp, &
file=input_file(1:len(trim(input_file))), &
form='formatted', &
access='sequential', &
iostat=ist, &
action='read')
if(ist /= 0) then
call fatal_error('Error while opening MMP input file')
end if
call ommp_message("Reading input parameters", OMMP_VERBOSE_DEBUG)
! Read input revision, supported revisions are 2 and 3.
read(iof_mmpinp,*) input_revision
if (input_revision /= 3 .and. input_revision /= 2) &
call fatal_error('MMP file is only supported with version 2 or 3.')
!TODO
call memory_init(.false., 0.0_rp)
call skip_lines(iof_mmpinp, 2)
read(iof_mmpinp,*) my_ff_type
read(iof_mmpinp,*) my_ff_rules
if(input_revision == 3) then
call skip_lines(iof_mmpinp, 17)
else if(input_revision == 2) then
call skip_lines(iof_mmpinp, 15)
end if
read(iof_mmpinp,*) my_mm_atoms
if(my_ff_type == 1) then
my_ld_cart = 10
else
my_ld_cart = 1
end if
call ommp_message("Allocating memory", OMMP_VERBOSE_DEBUG)
call mallocate('mmpol_init_from_mmp [my_cmm]', 3_ip, my_mm_atoms, my_cmm)
call mallocate('mmpol_init_from_mmp [my_q]', my_ld_cart, my_mm_atoms, my_q)
call mallocate('mmpol_init_from_mmp [my_pol]', my_mm_atoms, my_pol)
call mallocate('mmpol_init_from_mmp [my_pol_atoms]', my_mm_atoms, pol_atoms_list)
call mallocate('mmpol_init_from_mmp [my_ip11]', maxpgp, my_mm_atoms, my_ip11)
call skip_lines(iof_mmpinp, my_mm_atoms+1) ! Skip a zero and the section of atomic numbers
call ommp_message("Reading coordinates", OMMP_VERBOSE_DEBUG)
! coordinates:
do i = 1, my_mm_atoms
read(iof_mmpinp,*) my_cmm(1:3,i)
end do
call skip_lines(iof_mmpinp, my_mm_atoms) ! Skip section of residues number
call ommp_message("Reading fixed multipoles", OMMP_VERBOSE_DEBUG)
! charges/multipoles:
do i = 1, my_mm_atoms
read(iof_mmpinp,*) my_q(1:my_ld_cart,i)
end do
call ommp_message("Reading polarizabilities", OMMP_VERBOSE_DEBUG)
! polarizabilities:
my_pol = 0.0_rp
do i = 1, my_mm_atoms
read(iof_mmpinp,*) my_pol(i)
end do
call ommp_message("Processing polarizabilities", OMMP_VERBOSE_DEBUG)
! count how many atoms are polarizable:
! TODO this is more efficiently done with pack and count
my_pol_atoms = 0
pol_atoms_list(:) = 0
do i = 1, my_mm_atoms
if (my_pol(i) > thres) then
my_pol_atoms = my_pol_atoms + 1
pol_atoms_list(my_pol_atoms) = i
end if
end do
! remove null polarizabilities from the list
do i = 1, my_pol_atoms
my_pol(i) = my_pol(pol_atoms_list(i))
end do
my_pol(my_pol_atoms+1:my_mm_atoms) = 0.0_rp
call ommp_message("Initializing open mmpol module", OMMP_VERBOSE_DEBUG)
! mmpol module initialization
call mmpol_init(sys_obj, my_ff_type, my_mm_atoms, my_pol_atoms)
if(sys_obj%amoeba) then
call set_screening_parameters(sys_obj%eel, &
mscale_amoeba, &
pscale_amoeba, &
dscale_amoeba, &
uscale_amoeba, &
pscale_intra_amoeba)
sys_obj%eel%thole_scale = 0.0_rp
else
if(my_ff_rules == 1) then
call set_screening_parameters(sys_obj%eel, &
mscale_wang_dl, &
pscale_wang_dl, &
dscale_wang_dl, &
uscale_wang_dl)
sys_obj%eel%thole_scale = thole_scale_wang_dl
else if(my_ff_rules == 0) then
call set_screening_parameters(sys_obj%eel, &
mscale_wang_al, &
pscale_wang_al, &
dscale_wang_al, &
uscale_wang_al)
sys_obj%eel%thole_scale = thole_scale_wang_al
end if
end if
call ommp_message("Converting input units to A.U.", OMMP_VERBOSE_DEBUG)
! Copy data in the correct units (this means AU)
sys_obj%top%cmm = my_cmm * angstrom2au
sys_obj%eel%q = my_q
if(sys_obj%amoeba) then
my_pol = my_pol*angstrom2au**3
end if
sys_obj%eel%pol = my_pol(1:my_pol_atoms)
sys_obj%eel%polar_mm = pol_atoms_list(1:my_pol_atoms)
call mfree('mmpol_init_from_mmp [my_cmm]', my_cmm)
call mfree('mmpol_init_from_mmp [my_q]', my_q)
call mfree('mmpol_init_from_mmp [pol]', my_pol)
call ommp_message("Processing connectivity informations", OMMP_VERBOSE_DEBUG)
! 1-2 connectivity:
call mallocate('mmpol_init_from_mmp [i12]', maxn12, my_mm_atoms, i12)
do i = 1, my_mm_atoms
read(iof_mmpinp,*) i12(1:maxn12,i)
end do
! Writes the adjacency matrix in Yale sparse format in conn(1)
call adj_mat_from_conn(i12, sys_obj%top%conn(1))
call mfree('mmpol_init_from_mmp [i12]', i12)
if(sys_obj%amoeba) then
! group 11 connectivity:
! (to be replaced with polarization group)
do i = 1, my_mm_atoms
read(iof_mmpinp,*) my_ip11(1:maxpgp,i)
end do
call polgroup11_to_mm2pg(my_ip11, sys_obj%eel%mmat_polgrp)
call mfree('mmpol_init_from_mmp [my_ip11]', my_ip11)
! information to rotate the multipoles to the lab frame.
! mol_frame, iz, ix, iy:
do i = 1, my_mm_atoms
read(iof_mmpinp,*) sys_obj%eel%mol_frame(i), &
sys_obj%eel%iz(i), sys_obj%eel%ix(i), &
sys_obj%eel%iy(i)
end do
end if
! now, process the input, create all the required arrays
! and the correspondence lists:
call ommp_message("Populating utility arrays", OMMP_VERBOSE_DEBUG)
call mmpol_prepare(sys_obj)
close(iof_mmpinp)
call ommp_message("Initialization from MMP file done.", OMMP_VERBOSE_DEBUG)
call time_pull('MMPol initialization from .mmp file')
end subroutine mmpol_init_from_mmp