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