-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathHS88.SIF
297 lines (244 loc) · 7.57 KB
/
HS88.SIF
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
***************************
* SET UP THE INITIAL DATA *
***************************
NAME HS88
* Problem :
* *********
* A time-optimal heat conduction problem.
* Source: problem 88 in
* W. Hock and K. Schittkowski,
* "Test examples for nonlinear programming codes",
* Lectures Notes in Economics and Mathematical Systems 187, Springer
* Verlag, Heidelberg, 1981.
* SIF input: Nick Gould, September 1991.
* classification QOR2-MN-2-1
* Number of variables
IE N 2
* Constants
RE EPS 0.01
R* EPSSQR EPS EPS
RM -EPSSQR EPSSQR -1.0
* Other useful parameters
IE 1 1
IE 2 2
VARIABLES
DO I 1 N
X X(I)
ND
GROUPS
N OBJ
G CON
CONSTANTS
Z HS88 CON -EPSSQR
BOUNDS
FR HS88 'DEFAULT'
START POINT
DO I 1 N
DI I 2
X HS88 X(I) 0.5
ND
DO I 2 N
DI I 2
X HS88 X(I) -0.5
ND
HS88SOL X1 1.07337D+00
HS88SOL X2 -4.56044D-01
HS88SOL CON -1.03922D+03
ELEMENT TYPE
* SQR
EV SQR X
* H
EV H X1 X2
ELEMENT USES
DO I 1 N
XT O(I) SQR
ZV O(I) X X(I)
ND
XT H H
ZV H X1 X1
ZV H X2 X2
GROUP USES
DO I 1 N
XE OBJ O(I)
ND
E CON H -1.0
OBJECT BOUND
* Solution
*XL HS88SOL 1.36010D+00
ENDATA
***********************
* SET UP THE FUNCTION *
* AND RANGE ROUTINES *
***********************
ELEMENTS HS88
TEMPORARIES
R F
R G(2)
R H(2,2)
R EVAL88
F EVAL88
INDIVIDUALS
* Element type SQR
T SQR
F X * X
G X X + X
H X X 2.0D+0
* Element type H
T H
A F EVAL88( X1, X2,
A+ G, H )
F F
G X1 G(1)
G X2 G(2)
H X1 X1 H(1,1)
H X1 X2 H(1,2)
H X2 X2 H(2,2)
ENDATA
DOUBLE PRECISION FUNCTION EVAL88( X1, X2,
* G, H )
DOUBLE PRECISION X1, X2
DOUBLE PRECISION G( 2 ), H( 2, 2 )
INTEGER I , J , K , N , NP1, L
PARAMETER ( N = 2, NP1 = N + 1 )
LOGICAL CALC
DOUBLE PRECISION ALPHA , MUJ2 , T, MUI, MUJ , SMUI , U, SI ,
* RIJ , RHOI , RHOJ , EU, AI, AIMUI2, CMUI
DOUBLE PRECISION X ( N ), P( NP1 ),
* MU ( 30 ), A( 30 ), R( 30, 30 ), S( 30 ),
* RHO( 30 ), DRHO( 30, N ), D2RHO( 30, N, N )
INTRINSIC SIN , COS , EXP
SAVE A, AI, AIMUI2, CMUI, MUI, MUJ, R, S, SMUI, T
C
C Set data.
C
DATA CALC / .TRUE. /
DATA MU / 8.6033358901938017D-01, 3.4256184594817283D+00,
* 6.4372981791719468D+00, 9.5293344053619631D+00,
* 1.2645287223856643D+01, 1.5771284874815882D+01,
* 1.8902409956860023D+01, 2.2036496727938566D+01,
* 2.5172446326646664D+01, 2.8309642854452012D+01,
* 3.1447714637546234D+01, 3.4586424215288922D+01,
* 3.7725612827776501D+01, 4.0865170330488070D+01,
* 4.4005017920830845D+01, 4.7145097736761031D+01,
* 5.0285366337773652D+01, 5.3425790477394663D+01,
* 5.6566344279821521D+01, 5.9707007305335459D+01,
* 6.2847763194454451D+01, 6.5988598698490392D+01,
* 6.9129502973895256D+01, 7.2270467060308960D+01,
* 7.5411483488848148D+01, 7.8552545984242926D+01,
* 8.1693649235601683D+01, 8.4834788718042290D+01,
* 8.7975960552493220D+01, 9.1117161394464745D+01 /
C
C Calculate integration constants.
C
IF ( CALC ) THEN
T = 2.0D+0 / 1.5D+1
DO 20 I = 1, 30
MUI = MU( I )
SMUI = SIN( MUI )
CMUI = COS( MUI )
AI = 2.0D+0 * SMUI / ( MUI + SMUI * CMUI )
A( I ) = AI
S( I ) = 2.0D+0 * AI * ( CMUI - SMUI / MUI )
AIMUI2 = AI * MUI ** 2
DO 10 J = 1, I
IF ( I .NE. J ) THEN
MUJ = MU( J )
R( I, J ) = 5.0D-1 * (
* SIN( MUI + MUJ ) / ( MUI + MUJ ) +
* SIN( MUI - MUJ ) / ( MUI - MUJ ) ) *
* AIMUI2 * A( J ) * MUJ ** 2
R( J, I ) = R( I, J )
ELSE
R( I, I ) = 5.0D-1 * ( 1.0D+0 + 5.0D-1 *
* SIN( MUI + MUI ) / MUI ) *
* AIMUI2 ** 2
END IF
10 CONTINUE
20 CONTINUE
CALC = .FALSE.
END IF
C
C Assign values to variables.
C
X( 1 ) = X1
X( 2 ) = X2
C
C n 2
C Calculate the functions p(x) = SUM x .
C j i=j i
C
P( NP1 ) = 0.0D+0
DO 100 K = N, 1, - 1
P( K ) = P( K + 1 ) + X( K ) ** 2
100 CONTINUE
C
C Calculate the functions rho.
C
DO 190 J = 1, 30
MUJ2 = MU( J ) * MU( J )
U = EXP( - MUJ2 * P( 1 ) )
DO 120 K = 1, N
DRHO( J, K ) = 2.0D+0 * U * X( K )
DO 110 L = K, N
D2RHO( J, K, L ) = - 4.0D+0 * MUJ2 * U * X( K ) * X( L )
IF ( L .EQ. K ) D2RHO( J, K, L ) = D2RHO( J, K, L ) +
* 2.0D+0 * U
110 CONTINUE
120 CONTINUE
ALPHA = - 2.0D+0
DO 180 I = 2, N
EU = ALPHA * EXP( - MUJ2 * P( I ) )
U = U + EU
DO 140 K = I, N
DRHO( J, K ) = DRHO( J, K ) + 2.0D+0 * EU * X( K )
DO 130 L = K, N
D2RHO( J, K, L ) = D2RHO( J, K, L ) -
* 4.0D+0 * MUJ2 * EU * X( K ) * X( L )
IF ( L .EQ. K )
* D2RHO( J, K, L ) = D2RHO( J, K, L ) + 2.0D+0 * EU
130 CONTINUE
140 CONTINUE
ALPHA = - ALPHA
180 CONTINUE
U = U + 5.0D-1 * ALPHA
RHO( J ) = - U / MUJ2
190 CONTINUE
C
C Evaluate the function and derivatives.
C
EVAL88 = T
DO 320 K = 1, N
G( K ) = 0.0D+0
DO 310 L = K, N
H( K, L ) = 0.0D+0
310 CONTINUE
320 CONTINUE
DO 490 I = 1, 30
SI = S( I )
RHOI = RHO( I )
EVAL88 = EVAL88 + SI * RHOI
DO 420 K = 1, N
G( K ) = G( K ) + SI * DRHO( I, K )
DO 410 L = K, N
H( K, L ) = H( K, L ) + SI * D2RHO( I, K, L )
410 CONTINUE
420 CONTINUE
DO 480 J = 1, 30
RIJ = R( I, J )
RHOJ = RHO( J )
EVAL88 = EVAL88 + RIJ * RHOI * RHOJ
DO 440 K = 1, N
G( K ) = G( K ) + RIJ * ( RHOI * DRHO( J, K ) +
* RHOJ * DRHO( I, K ) )
DO 430 L = K, N
H( K, L ) = H( K, L ) + RIJ * (
* RHOI * D2RHO( J, K, L ) +
* RHOJ * D2RHO( I, K, L ) +
* DRHO( I, K ) * DRHO( J, L ) +
* DRHO( J, K ) * DRHO( I, L ) )
430 CONTINUE
440 CONTINUE
480 CONTINUE
490 CONTINUE
RETURN
END