1MODULE TEST
2  IMPLICIT NONE
3  INTEGER, PARAMETER :: dp=KIND(0.0D0)
4  TYPE mulliken_restraint_type
5    INTEGER                         :: ref_count
6    REAL(KIND = dp)                 :: strength
7    REAL(KIND = dp)                 :: TARGET
8    INTEGER                         :: natoms
9    INTEGER, POINTER, DIMENSION(:)  :: atoms
10  END TYPE mulliken_restraint_type
11CONTAINS
12  SUBROUTINE INIT(mulliken)
13   TYPE(mulliken_restraint_type), INTENT(INOUT) :: mulliken
14   ALLOCATE(mulliken%atoms(1))
15   mulliken%atoms(1)=1
16   mulliken%natoms=1
17   mulliken%target=0
18   mulliken%strength=0
19  END SUBROUTINE INIT
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
26
27    INTEGER                                  :: I
28    REAL(KIND=dp)                            :: dum
29
30    charges_deriv=0.0_dp
31    order_p=0.0_dp
32
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)
36    ENDDO
37
38energy=mulliken_restraint_control%strength*(order_p-mulliken_restraint_control%target)**2
39
40dum=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
44    ENDDO
45END SUBROUTINE restraint_functional
46
47END MODULE
48
49    USE TEST
50    IMPLICIT NONE
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))
55    charges(1,1)=2.0_dp
56    charges(1,2)=1.0_dp
57    CALL INIT(mulliken)
58    CALL restraint_functional(mulliken,charges,charges_deriv,energy,order_p)
59    write(6,*) order_p
60END
61
62