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