-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathm_cutoffs.f90
148 lines (130 loc) · 3.25 KB
/
m_cutoffs.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
!---------------------------------------------------------------------------
! MELQUIADES: Metropolis Monte Carlo Program !
!---------------------------------------------------------------------------
!bop
!
! !Module: m_cutoffs
!
! !Description: This module contains routines for calculating cut-off values.
!\\
!\\
! !Interface:
!
module m_cutoffs
!
! !Uses:
!
use m_kind
use m_simtype
use m_boxtype
implicit none
!
! !Public member functions:
!
public :: r_cuts
!
! !Revision history:
! 06Aug 2015 Asdrubal Lozada
!
!eop
!------------------------------------------------------------------------
contains
!
!bop
!
! !Iroutine: r_cuts
! !Description: This routine calculates the total cut-off value as
!function of the molecular topology.
!\begin{equation*}
!r_{c} = cut-off + max(d_{1},d_{2},d_{3},\cdots)
!\end{equation*}
!\vspace{-\topsep}
!\\
!\\
! !Interface:
!
subroutine r_cuts( y, x )
!
implicit none
!
! !Input parameters:
type(simulation), intent(inout) :: y
type(box), pointer :: x
!
! !Revision history:
! 06Aug 2015 Asdrubal Lozada
!
!eop
!---------------------------------------------------------------------
! Local variables
real(rkind) :: dist, mx_dma
real(rkind) :: dist2, mx_dma2
integer :: i, k, l
integer :: num ! temporary iterator
logical :: logic ! temporary logic variable
y%m_rcutsq = y%m_cutoff * y%m_cutoff
x%m_fn = 0.0_rkind
x%m_fns = 0.0_rkind
num = 0
if(.not.y%m_solute) then
do k = 1, y%m_ntf
num = num + x%m_nmol(k)
do i = 1, x%m_nsite(k)
dist = x%m_site(1,i,num)*x%m_site(1,i,num)+&
& x%m_site(2,i,num)*x%m_site(2,i,num)+&
& x%m_site(3,i,num)*x%m_site(3,i,num)
if(dist >= x%m_fn(k)) x%m_fn(k) = dist
end do ! i
x%m_fn(k) = dsqrt(x%m_fn(k))
end do ! k
!boc
mx_dma = x%m_fn(1)
if( y%m_ntf > 1) then
do k = 2, y%m_ntf
if( x%m_fn(k) > mx_dma) mx_dma = x%m_fn(k)
end do
end if
y%m_rpair = (y%m_cutoff + 2 * mx_dma) * (y%m_cutoff + 2 * mx_dma)
y%m_cutoff = y%m_cutoff + 2 * mx_dma
!eoc
else
do k = 1, y%m_ntf
logic = .false.
num = num + x%m_nmol(k)
do l = 1, y%m_iexcl
if( x%m_idtype(num) == x%m_extype(l) ) then
logic = .true.
exit
end if ! id_type
end do ! l
if( .not.logic ) then
do i = 1, x%m_nsite(k)
dist = x%m_site(1,i,num)*x%m_site(1,i,num)+&
& x%m_site(2,i,num)*x%m_site(2,i,num)+&
& x%m_site(3,i,num)*x%m_site(3,i,num)
if( dist >= x%m_fn(k) ) x%m_fn(k) = dist
end do ! i
x%m_fn(k) = sqrt(x%m_fn(k))
end if
do i = 1, x%m_nsite(k)
dist2 = x%m_site(1,i,num)*x%m_site(1,i,num)+&
& x%m_site(2,i,num)*x%m_site(2,i,num)+&
& x%m_site(3,i,num)*x%m_site(3,i,num)
if(dist2 >= x%m_fns(k)) x%m_fns(k) = dist2
end do ! i
x%m_fns(k) = sqrt(x%m_fns(k))
end do ! k
mx_dma = x%m_fn(1)
mx_dma2 = x%m_fns(1)
if( y%m_ntf > 1 ) then
do k = 2, y%m_ntf
if( x%m_fn(k) > mx_dma ) mx_dma = x%m_fn(k)
if( x%m_fns(k) > mx_dma2 ) mx_dma2 = x%m_fns(k)
end do
end if
y%m_rpair = (y%m_cutoff + 2 * mx_dma) * (y%m_cutoff + 2 * mx_dma)
y%m_rsol = (y%m_cutsol + 2 * mx_dma2) * &
& (y%m_cutsol + 2 * mx_dma2)
end if ! main condition
end subroutine r_cuts
end module m_cutoffs