Commit a8404c43 authored by chrmuell's avatar chrmuell

included gradient calculation of TIP4P (same way as in LJ)

parent a672a624
......@@ -19,12 +19,14 @@ C
C
C Energy and gradient for rigid body TIP4P using new rigid body
C derivative functions etc.
C Energy for rigid body TIP4P
C
SUBROUTINE TIP4P(ETIP,X,m,n,lbounds,ubounds) !,V,ELJ,GTEST,SECT)
USE cmaes_param_mod
IMPLICIT NONE
INTEGER, INTENT(in) :: m ! (3*LJ_N-6) dim vector
INTEGER, INTENT(in) :: m ! (3*N) dim vector
INTEGER, INTENT(in) :: n
REAL(MK), DIMENSION(n) :: ETIP
REAL(MK), DIMENSION(m,n),INTENT(in) :: X
......@@ -53,8 +55,45 @@ C
END SUBROUTINE TIP4P
C Energy and gradient for rigid body TIP4P
C
SUBROUTINE TIP4P_GRAD(ETIP,X,V,m,n,lbounds,ubounds)
USE cmaes_param_mod
IMPLICIT NONE
INTEGER, INTENT(in) :: m ! (3*numAtoms) vec
INTEGER, INTENT(in) :: n ! number of vector
REAL(MK), DIMENSION(n) :: ETIP
REAL(MK), DIMENSION(m,n),INTENT(in) :: X
REAL(MK), DIMENSION(m,n),INTENT(out) :: V
REAL(MK), OPTIONAL :: lbounds
REAL(MK), OPTIONAL :: ubounds
!local vars
REAL(MK), DIMENSION(m) :: X_full
REAL(MK), DIMENSION(m) :: V_full
INTEGER :: i,j
LOGICAL :: GTEST
LOGICAL :: SECT
REAL(MK) :: ETIP_local
GTEST = .TRUE.
SECT = .FALSE.
DO i = 1,n
X_full = X(:,i)
CALL TIP4P_org(X_full,V_full,ETIP_local,GTEST,SECT,m/3)
V(:,i) = V_full(:)
ETIP(i) = ETIP_local
END DO
END SUBROUTINE TIP4P_GRAD
SUBROUTINE TIP4P_org(X,V,ETIP,GTEST,SECT, NATOMS)
IMPLICIT NONE
LOGICAL GTEST,SECT
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment