| MODULE TEST |
| IMPLICIT NONE |
| INTEGER, PARAMETER :: dp=KIND(0.0D0) |
| TYPE mulliken_restraint_type |
| INTEGER :: ref_count |
| REAL(KIND = dp) :: strength |
| REAL(KIND = dp) :: TARGET |
| INTEGER :: natoms |
| INTEGER, POINTER, DIMENSION(:) :: atoms |
| END TYPE mulliken_restraint_type |
| CONTAINS |
| SUBROUTINE INIT(mulliken) |
| TYPE(mulliken_restraint_type), INTENT(INOUT) :: mulliken |
| ALLOCATE(mulliken%atoms(1)) |
| mulliken%atoms(1)=1 |
| mulliken%natoms=1 |
| mulliken%target=0 |
| mulliken%strength=0 |
| END SUBROUTINE INIT |
| SUBROUTINE restraint_functional(mulliken_restraint_control,charges, & |
| charges_deriv,energy,order_p) |
| TYPE(mulliken_restraint_type), & |
| INTENT(IN) :: mulliken_restraint_control |
| REAL(KIND=dp), DIMENSION(:, :), POINTER :: charges, charges_deriv |
| REAL(KIND=dp), INTENT(OUT) :: energy, order_p |
| |
| INTEGER :: I |
| REAL(KIND=dp) :: dum |
| |
| charges_deriv=0.0_dp |
| order_p=0.0_dp |
| |
| DO I=1,mulliken_restraint_control%natoms |
| order_p=order_p+charges(mulliken_restraint_control%atoms(I),1) & |
| -charges(mulliken_restraint_control%atoms(I),2) |
| ENDDO |
| |
| energy=mulliken_restraint_control%strength*(order_p-mulliken_restraint_control%target)**2 |
| |
| dum=2*mulliken_restraint_control%strength*(order_p-mulliken_restraint_control%target) |
| DO I=1,mulliken_restraint_control%natoms |
| charges_deriv(mulliken_restraint_control%atoms(I),1)= dum |
| charges_deriv(mulliken_restraint_control%atoms(I),2)= -dum |
| ENDDO |
| END SUBROUTINE restraint_functional |
| |
| END MODULE |
| |
| USE TEST |
| IMPLICIT NONE |
| TYPE(mulliken_restraint_type) :: mulliken |
| REAL(KIND=dp), DIMENSION(:, :), POINTER :: charges, charges_deriv |
| REAL(KIND=dp) :: energy,order_p |
| ALLOCATE(charges(1,2),charges_deriv(1,2)) |
| charges(1,1)=2.0_dp |
| charges(1,2)=1.0_dp |
| CALL INIT(mulliken) |
| CALL restraint_functional(mulliken,charges,charges_deriv,energy,order_p) |
| write(6,*) order_p |
| END |
| |
