-
Notifications
You must be signed in to change notification settings - Fork 1
Expand file tree
/
Copy pathbitss.f90
More file actions
88 lines (69 loc) · 2.76 KB
/
bitss.f90
File metadata and controls
88 lines (69 loc) · 2.76 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
MODULE BITSSMODULE
USE COMMONS, ONLY : NOPT
IMPLICIT NONE
CONTAINS
SUBROUTINE BITSS(COORDS1, COORDS2)
USE KEY, ONLY : BITSS_MAXITER, BITSS_STEP, BITSS_COEFITER, BITSSLBFGS_MAXITER
USE BITSS_POTENTIAL, ONLY : DISTANCE, TARGET_DIST
USE BITSS_LBFGS, ONLY : MINIMISE
DOUBLE PRECISION :: COORDS1(NOPT), COORDS2(NOPT)
INTEGER :: ITER1, ITER2
DOUBLE PRECISION :: COORDS(2*NOPT)
LOGICAL :: MIN_CONVERGED
TARGET_DIST = DISTANCE(COORDS1, COORDS2)
DO ITER1 = 1, BITSS_MAXITER
TARGET_DIST = (1 - BITSS_STEP) * TARGET_DIST
! Minimise while updating the constraint coefficients
MIN_CONVERGED = .FALSE.
DO ITER2 = 1, BITSSLBFGS_MAXITER / BITSS_COEFITER
CALL COMPUTE_COEF(COORDS1, COORDS2)
COORDS(1:NOPT) = COORDS1
COORDS(NOPT+1:2*NOPT) = COORDS2
MIN_CONVERGED = MINIMISE(COORDS)
COORDS1 = COORDS(1:NOPT)
COORDS2 = COORDS(NOPT+1:2*NOPT)
IF (MIN_CONVERGED) EXIT
END DO
IF (CHECK_CONVERGENCE(COORDS1, COORDS2)) EXIT
END DO
END SUBROUTINE BITSS
FUNCTION BARRIER_ESTIMATE(COORDS1, COORDS2)
DOUBLE PRECISION :: COORDS1(NOPT), COORDS2(NOPT)
DOUBLE PRECISION :: BARRIER_ESTIMATE
INTEGER :: I
DOUBLE PRECISION :: EMIN, EMAX, T, COORDST(NOPT), E1, E2, G(NOPT), RMS
CALL POTENTIAL(COORDS1, E1, G, .FALSE., .FALSE., RMS, .FALSE., .FALSE.)
CALL POTENTIAL(COORDS2, E2, G, .FALSE., .FALSE., RMS, .FALSE., .FALSE.)
EMIN = MAX(E1, E2)
EMAX = - HUGE(EMAX)
DO I = 1, 9
T = I / 10D0
COORDST = (1-T)*COORDS1 + T*COORDS2
CALL POTENTIAL(COORDST, E1, G, .FALSE., .FALSE., RMS, .FALSE., .FALSE.)
EMAX = MAX(EMAX, E1)
END DO
BARRIER_ESTIMATE = EMAX - EMIN
END FUNCTION BARRIER_ESTIMATE
SUBROUTINE COMPUTE_COEF(COORDS1, COORDS2)
USE KEY, ONLY : BITSS_ALPHA, BITSS_BETA
USE BITSS_POTENTIAL, ONLY : DISTANCE, KE, KD
DOUBLE PRECISION, INTENT(IN) :: COORDS1(NOPT), COORDS2(NOPT)
DOUBLE PRECISION :: EB, D, KD1, KD2, E, G1(NOPT), G2(NOPT), RMS
EB = BARRIER_ESTIMATE(COORDS1, COORDS2)
IF (EB <= 0) RETURN ! Do not update coefficients
D = DISTANCE(COORDS1, COORDS2)
CALL POTENTIAL(COORDS1, E, G1, .TRUE., .FALSE., RMS, .FALSE., .FALSE.)
CALL POTENTIAL(COORDS2, E, G2, .TRUE., .FALSE., RMS, .FALSE., .FALSE.)
KE = BITSS_ALPHA / (2 * EB)
KD1 = SQRT(SUM(G1**2) + SUM(G2**2)) / (2.8284 * BITSS_BETA * D)
KD2 = EB / (BITSS_BETA * D**2)
KD = MAX(KD1, KD2)
END SUBROUTINE COMPUTE_COEF
FUNCTION CHECK_CONVERGENCE(COORDS1, COORDS2)
USE KEY, ONLY : BITSS_STOP
USE BITSS_POTENTIAL, ONLY : TARGET_DIST
DOUBLE PRECISION :: COORDS1(NOPT), COORDS2(NOPT)
LOGICAL :: CHECK_CONVERGENCE
CHECK_CONVERGENCE = TARGET_DIST < BITSS_STOP
END FUNCTION CHECK_CONVERGENCE
END MODULE BITSSMODULE