3 INTEGER, PARAMETER :: dp
=KIND(0.0D0
)
4 TYPE mulliken_restraint_type
6 REAL(KIND
= dp
) :: strength
7 REAL(KIND
= dp
) :: TARGET
9 INTEGER, POINTER, DIMENSION(:) :: atoms
10 END TYPE mulliken_restraint_type
12 SUBROUTINE INIT(mulliken
)
13 TYPE(mulliken_restraint_type
), INTENT(INOUT
) :: mulliken
14 ALLOCATE(mulliken
%atoms(1))
20 SUBROUTINE restraint_functional(mulliken_restraint_control
,charges
, &
21 charges_deriv
,energy
,order_p
)
22 TYPE(mulliken_restraint_type
), &
23 INTENT(IN
) :: mulliken_restraint_control
24 REAL(KIND
=dp
), DIMENSION(:, :), POINTER :: charges
, charges_deriv
25 REAL(KIND
=dp
), INTENT(OUT
) :: energy
, order_p
33 DO I
=1,mulliken_restraint_control
%natoms
34 order_p
=order_p
+charges(mulliken_restraint_control
%atoms(I
),1) &
35 -charges(mulliken_restraint_control
%atoms(I
),2)
38 energy
=mulliken_restraint_control
%strength
*(order_p
-mulliken_restraint_control
%target
)**2
40 dum
=2*mulliken_restraint_control
%strength
*(order_p
-mulliken_restraint_control
%target
)
41 DO I
=1,mulliken_restraint_control
%natoms
42 charges_deriv(mulliken_restraint_control
%atoms(I
),1)= dum
43 charges_deriv(mulliken_restraint_control
%atoms(I
),2)= -dum
45 END SUBROUTINE restraint_functional
51 TYPE(mulliken_restraint_type
) :: mulliken
52 REAL(KIND
=dp
), DIMENSION(:, :), POINTER :: charges
, charges_deriv
53 REAL(KIND
=dp
) :: energy
,order_p
54 ALLOCATE(charges(1,2),charges_deriv(1,2))
58 CALL restraint_functional(mulliken
,charges
,charges_deriv
,energy
,order_p
)