| 1 | subroutine ssqfcn(m,n,x,fvec,nprob)
|
|---|
| 2 | integer m,n,nprob
|
|---|
| 3 | double precision x(n),fvec(m)
|
|---|
| 4 | c **********
|
|---|
| 5 | c
|
|---|
| 6 | c subroutine ssqfcn
|
|---|
| 7 | c
|
|---|
| 8 | c this subroutine defines the functions of eighteen nonlinear
|
|---|
| 9 | c least squares problems. the allowable values of (m,n) for
|
|---|
| 10 | c functions 1,2 and 3 are variable but with m .ge. n.
|
|---|
| 11 | c for functions 4,5,6,7,8,9 and 10 the values of (m,n) are
|
|---|
| 12 | c (2,2),(3,3),(4,4),(2,2),(15,3),(11,4) and (16,3), respectively.
|
|---|
| 13 | c function 11 (watson) has m = 31 with n usually 6 or 9.
|
|---|
| 14 | c however, any n, n = 2,...,31, is permitted.
|
|---|
| 15 | c functions 12,13 and 14 have n = 3,2 and 4, respectively, but
|
|---|
| 16 | c allow any m .ge. n, with the usual choices being 10,10 and 20.
|
|---|
| 17 | c function 15 (chebyquad) allows m and n variable with m .ge. n.
|
|---|
| 18 | c function 16 (brown) allows n variable with m = n.
|
|---|
| 19 | c for functions 17 and 18, the values of (m,n) are
|
|---|
| 20 | c (33,5) and (65,11), respectively.
|
|---|
| 21 | c
|
|---|
| 22 | c the subroutine statement is
|
|---|
| 23 | c
|
|---|
| 24 | c subroutine ssqfcn(m,n,x,fvec,nprob)
|
|---|
| 25 | c
|
|---|
| 26 | c where
|
|---|
| 27 | c
|
|---|
| 28 | c m and n are positive integer input variables. n must not
|
|---|
| 29 | c exceed m.
|
|---|
| 30 | c
|
|---|
| 31 | c x is an input array of length n.
|
|---|
| 32 | c
|
|---|
| 33 | c fvec is an output array of length m which contains the nprob
|
|---|
| 34 | c function evaluated at x.
|
|---|
| 35 | c
|
|---|
| 36 | c nprob is a positive integer input variable which defines the
|
|---|
| 37 | c number of the problem. nprob must not exceed 18.
|
|---|
| 38 | c
|
|---|
| 39 | c subprograms called
|
|---|
| 40 | c
|
|---|
| 41 | c fortran-supplied ... datan,dcos,dexp,dsin,dsqrt,dsign
|
|---|
| 42 | c
|
|---|
| 43 | c argonne national laboratory. minpack project. march 1980.
|
|---|
| 44 | c burton s. garbow, kenneth e. hillstrom, jorge j. more
|
|---|
| 45 | c
|
|---|
| 46 | c **********
|
|---|
| 47 | integer i,iev,ivar,j,nm1
|
|---|
| 48 | double precision c13,c14,c29,c45,div,dx,eight,five,one,prod,sum,
|
|---|
| 49 | * s1,s2,temp,ten,ti,tmp1,tmp2,tmp3,tmp4,tpi,two,
|
|---|
| 50 | * zero,zp25,zp5
|
|---|
| 51 | double precision v(11),y1(15),y2(11),y3(16),y4(33),y5(65)
|
|---|
| 52 | double precision dfloat
|
|---|
| 53 | data zero,zp25,zp5,one,two,five,eight,ten,c13,c14,c29,c45
|
|---|
| 54 | * /0.0d0,2.5d-1,5.0d-1,1.0d0,2.0d0,5.0d0,8.0d0,1.0d1,1.3d1,
|
|---|
| 55 | * 1.4d1,2.9d1,4.5d1/
|
|---|
| 56 | data v(1),v(2),v(3),v(4),v(5),v(6),v(7),v(8),v(9),v(10),v(11)
|
|---|
| 57 | * /4.0d0,2.0d0,1.0d0,5.0d-1,2.5d-1,1.67d-1,1.25d-1,1.0d-1,
|
|---|
| 58 | * 8.33d-2,7.14d-2,6.25d-2/
|
|---|
| 59 | data y1(1),y1(2),y1(3),y1(4),y1(5),y1(6),y1(7),y1(8),y1(9),
|
|---|
| 60 | * y1(10),y1(11),y1(12),y1(13),y1(14),y1(15)
|
|---|
| 61 | * /1.4d-1,1.8d-1,2.2d-1,2.5d-1,2.9d-1,3.2d-1,3.5d-1,3.9d-1,
|
|---|
| 62 | * 3.7d-1,5.8d-1,7.3d-1,9.6d-1,1.34d0,2.1d0,4.39d0/
|
|---|
| 63 | data y2(1),y2(2),y2(3),y2(4),y2(5),y2(6),y2(7),y2(8),y2(9),
|
|---|
| 64 | * y2(10),y2(11)
|
|---|
| 65 | * /1.957d-1,1.947d-1,1.735d-1,1.6d-1,8.44d-2,6.27d-2,4.56d-2,
|
|---|
| 66 | * 3.42d-2,3.23d-2,2.35d-2,2.46d-2/
|
|---|
| 67 | data y3(1),y3(2),y3(3),y3(4),y3(5),y3(6),y3(7),y3(8),y3(9),
|
|---|
| 68 | * y3(10),y3(11),y3(12),y3(13),y3(14),y3(15),y3(16)
|
|---|
| 69 | * /3.478d4,2.861d4,2.365d4,1.963d4,1.637d4,1.372d4,1.154d4,
|
|---|
| 70 | * 9.744d3,8.261d3,7.03d3,6.005d3,5.147d3,4.427d3,3.82d3,
|
|---|
| 71 | * 3.307d3,2.872d3/
|
|---|
| 72 | data y4(1),y4(2),y4(3),y4(4),y4(5),y4(6),y4(7),y4(8),y4(9),
|
|---|
| 73 | * y4(10),y4(11),y4(12),y4(13),y4(14),y4(15),y4(16),y4(17),
|
|---|
| 74 | * y4(18),y4(19),y4(20),y4(21),y4(22),y4(23),y4(24),y4(25),
|
|---|
| 75 | * y4(26),y4(27),y4(28),y4(29),y4(30),y4(31),y4(32),y4(33)
|
|---|
| 76 | * /8.44d-1,9.08d-1,9.32d-1,9.36d-1,9.25d-1,9.08d-1,8.81d-1,
|
|---|
| 77 | * 8.5d-1,8.18d-1,7.84d-1,7.51d-1,7.18d-1,6.85d-1,6.58d-1,
|
|---|
| 78 | * 6.28d-1,6.03d-1,5.8d-1,5.58d-1,5.38d-1,5.22d-1,5.06d-1,
|
|---|
| 79 | * 4.9d-1,4.78d-1,4.67d-1,4.57d-1,4.48d-1,4.38d-1,4.31d-1,
|
|---|
| 80 | * 4.24d-1,4.2d-1,4.14d-1,4.11d-1,4.06d-1/
|
|---|
| 81 | data y5(1),y5(2),y5(3),y5(4),y5(5),y5(6),y5(7),y5(8),y5(9),
|
|---|
| 82 | * y5(10),y5(11),y5(12),y5(13),y5(14),y5(15),y5(16),y5(17),
|
|---|
| 83 | * y5(18),y5(19),y5(20),y5(21),y5(22),y5(23),y5(24),y5(25),
|
|---|
| 84 | * y5(26),y5(27),y5(28),y5(29),y5(30),y5(31),y5(32),y5(33),
|
|---|
| 85 | * y5(34),y5(35),y5(36),y5(37),y5(38),y5(39),y5(40),y5(41),
|
|---|
| 86 | * y5(42),y5(43),y5(44),y5(45),y5(46),y5(47),y5(48),y5(49),
|
|---|
| 87 | * y5(50),y5(51),y5(52),y5(53),y5(54),y5(55),y5(56),y5(57),
|
|---|
| 88 | * y5(58),y5(59),y5(60),y5(61),y5(62),y5(63),y5(64),y5(65)
|
|---|
| 89 | * /1.366d0,1.191d0,1.112d0,1.013d0,9.91d-1,8.85d-1,8.31d-1,
|
|---|
| 90 | * 8.47d-1,7.86d-1,7.25d-1,7.46d-1,6.79d-1,6.08d-1,6.55d-1,
|
|---|
| 91 | * 6.16d-1,6.06d-1,6.02d-1,6.26d-1,6.51d-1,7.24d-1,6.49d-1,
|
|---|
| 92 | * 6.49d-1,6.94d-1,6.44d-1,6.24d-1,6.61d-1,6.12d-1,5.58d-1,
|
|---|
| 93 | * 5.33d-1,4.95d-1,5.0d-1,4.23d-1,3.95d-1,3.75d-1,3.72d-1,
|
|---|
| 94 | * 3.91d-1,3.96d-1,4.05d-1,4.28d-1,4.29d-1,5.23d-1,5.62d-1,
|
|---|
| 95 | * 6.07d-1,6.53d-1,6.72d-1,7.08d-1,6.33d-1,6.68d-1,6.45d-1,
|
|---|
| 96 | * 6.32d-1,5.91d-1,5.59d-1,5.97d-1,6.25d-1,7.39d-1,7.1d-1,
|
|---|
| 97 | * 7.29d-1,7.2d-1,6.36d-1,5.81d-1,4.28d-1,2.92d-1,1.62d-1,
|
|---|
| 98 | * 9.8d-2,5.4d-2/
|
|---|
| 99 | dfloat(ivar) = ivar
|
|---|
| 100 | c
|
|---|
| 101 | c function routine selector.
|
|---|
| 102 | c
|
|---|
| 103 | go to (10,40,70,110,120,130,140,150,170,190,210,250,270,290,310,
|
|---|
| 104 | * 360,390,410), nprob
|
|---|
| 105 | c
|
|---|
| 106 | c linear function - full rank.
|
|---|
| 107 | c
|
|---|
| 108 | 10 continue
|
|---|
| 109 | sum = zero
|
|---|
| 110 | do 20 j = 1, n
|
|---|
| 111 | sum = sum + x(j)
|
|---|
| 112 | 20 continue
|
|---|
| 113 | temp = two*sum/dfloat(m) + one
|
|---|
| 114 | do 30 i = 1, m
|
|---|
| 115 | fvec(i) = -temp
|
|---|
| 116 | if (i .le. n) fvec(i) = fvec(i) + x(i)
|
|---|
| 117 | 30 continue
|
|---|
| 118 | go to 430
|
|---|
| 119 | c
|
|---|
| 120 | c linear function - rank 1.
|
|---|
| 121 | c
|
|---|
| 122 | 40 continue
|
|---|
| 123 | sum = zero
|
|---|
| 124 | do 50 j = 1, n
|
|---|
| 125 | sum = sum + dfloat(j)*x(j)
|
|---|
| 126 | 50 continue
|
|---|
| 127 | do 60 i = 1, m
|
|---|
| 128 | fvec(i) = dfloat(i)*sum - one
|
|---|
| 129 | 60 continue
|
|---|
| 130 | go to 430
|
|---|
| 131 | c
|
|---|
| 132 | c linear function - rank 1 with zero columns and rows.
|
|---|
| 133 | c
|
|---|
| 134 | 70 continue
|
|---|
| 135 | sum = zero
|
|---|
| 136 | nm1 = n - 1
|
|---|
| 137 | if (nm1 .lt. 2) go to 90
|
|---|
| 138 | do 80 j = 2, nm1
|
|---|
| 139 | sum = sum + dfloat(j)*x(j)
|
|---|
| 140 | 80 continue
|
|---|
| 141 | 90 continue
|
|---|
| 142 | do 100 i = 1, m
|
|---|
| 143 | fvec(i) = dfloat(i-1)*sum - one
|
|---|
| 144 | 100 continue
|
|---|
| 145 | fvec(m) = -one
|
|---|
| 146 | go to 430
|
|---|
| 147 | c
|
|---|
| 148 | c rosenbrock function.
|
|---|
| 149 | c
|
|---|
| 150 | 110 continue
|
|---|
| 151 | fvec(1) = ten*(x(2) - x(1)**2)
|
|---|
| 152 | fvec(2) = one - x(1)
|
|---|
| 153 | go to 430
|
|---|
| 154 | c
|
|---|
| 155 | c helical valley function.
|
|---|
| 156 | c
|
|---|
| 157 | 120 continue
|
|---|
| 158 | tpi = eight*datan(one)
|
|---|
| 159 | tmp1 = dsign(zp25,x(2))
|
|---|
| 160 | if (x(1) .gt. zero) tmp1 = datan(x(2)/x(1))/tpi
|
|---|
| 161 | if (x(1) .lt. zero) tmp1 = datan(x(2)/x(1))/tpi + zp5
|
|---|
| 162 | tmp2 = dsqrt(x(1)**2+x(2)**2)
|
|---|
| 163 | fvec(1) = ten*(x(3) - ten*tmp1)
|
|---|
| 164 | fvec(2) = ten*(tmp2 - one)
|
|---|
| 165 | fvec(3) = x(3)
|
|---|
| 166 | go to 430
|
|---|
| 167 | c
|
|---|
| 168 | c powell singular function.
|
|---|
| 169 | c
|
|---|
| 170 | 130 continue
|
|---|
| 171 | fvec(1) = x(1) + ten*x(2)
|
|---|
| 172 | fvec(2) = dsqrt(five)*(x(3) - x(4))
|
|---|
| 173 | fvec(3) = (x(2) - two*x(3))**2
|
|---|
| 174 | fvec(4) = dsqrt(ten)*(x(1) - x(4))**2
|
|---|
| 175 | go to 430
|
|---|
| 176 | c
|
|---|
| 177 | c freudenstein and roth function.
|
|---|
| 178 | c
|
|---|
| 179 | 140 continue
|
|---|
| 180 | fvec(1) = -c13 + x(1) + ((five - x(2))*x(2) - two)*x(2)
|
|---|
| 181 | fvec(2) = -c29 + x(1) + ((one + x(2))*x(2) - c14)*x(2)
|
|---|
| 182 | go to 430
|
|---|
| 183 | c
|
|---|
| 184 | c bard function.
|
|---|
| 185 | c
|
|---|
| 186 | 150 continue
|
|---|
| 187 | do 160 i = 1, 15
|
|---|
| 188 | tmp1 = dfloat(i)
|
|---|
| 189 | tmp2 = dfloat(16-i)
|
|---|
| 190 | tmp3 = tmp1
|
|---|
| 191 | if (i .gt. 8) tmp3 = tmp2
|
|---|
| 192 | fvec(i) = y1(i) - (x(1) + tmp1/(x(2)*tmp2 + x(3)*tmp3))
|
|---|
| 193 | 160 continue
|
|---|
| 194 | go to 430
|
|---|
| 195 | c
|
|---|
| 196 | c kowalik and osborne function.
|
|---|
| 197 | c
|
|---|
| 198 | 170 continue
|
|---|
| 199 | do 180 i = 1, 11
|
|---|
| 200 | tmp1 = v(i)*(v(i) + x(2))
|
|---|
| 201 | tmp2 = v(i)*(v(i) + x(3)) + x(4)
|
|---|
| 202 | fvec(i) = y2(i) - x(1)*tmp1/tmp2
|
|---|
| 203 | 180 continue
|
|---|
| 204 | go to 430
|
|---|
| 205 | c
|
|---|
| 206 | c meyer function.
|
|---|
| 207 | c
|
|---|
| 208 | 190 continue
|
|---|
| 209 | do 200 i = 1, 16
|
|---|
| 210 | temp = five*dfloat(i) + c45 + x(3)
|
|---|
| 211 | tmp1 = x(2)/temp
|
|---|
| 212 | tmp2 = dexp(tmp1)
|
|---|
| 213 | fvec(i) = x(1)*tmp2 - y3(i)
|
|---|
| 214 | 200 continue
|
|---|
| 215 | go to 430
|
|---|
| 216 | c
|
|---|
| 217 | c watson function.
|
|---|
| 218 | c
|
|---|
| 219 | 210 continue
|
|---|
| 220 | do 240 i = 1, 29
|
|---|
| 221 | div = dfloat(i)/c29
|
|---|
| 222 | s1 = zero
|
|---|
| 223 | dx = one
|
|---|
| 224 | do 220 j = 2, n
|
|---|
| 225 | s1 = s1 + dfloat(j-1)*dx*x(j)
|
|---|
| 226 | dx = div*dx
|
|---|
| 227 | 220 continue
|
|---|
| 228 | s2 = zero
|
|---|
| 229 | dx = one
|
|---|
| 230 | do 230 j = 1, n
|
|---|
| 231 | s2 = s2 + dx*x(j)
|
|---|
| 232 | dx = div*dx
|
|---|
| 233 | 230 continue
|
|---|
| 234 | fvec(i) = s1 - s2**2 - one
|
|---|
| 235 | 240 continue
|
|---|
| 236 | fvec(30) = x(1)
|
|---|
| 237 | fvec(31) = x(2) - x(1)**2 - one
|
|---|
| 238 | go to 430
|
|---|
| 239 | c
|
|---|
| 240 | c box 3-dimensional function.
|
|---|
| 241 | c
|
|---|
| 242 | 250 continue
|
|---|
| 243 | do 260 i = 1, m
|
|---|
| 244 | temp = dfloat(i)
|
|---|
| 245 | tmp1 = temp/ten
|
|---|
| 246 | fvec(i) = dexp(-tmp1*x(1)) - dexp(-tmp1*x(2))
|
|---|
| 247 | * + (dexp(-temp) - dexp(-tmp1))*x(3)
|
|---|
| 248 | 260 continue
|
|---|
| 249 | go to 430
|
|---|
| 250 | c
|
|---|
| 251 | c jennrich and sampson function.
|
|---|
| 252 | c
|
|---|
| 253 | 270 continue
|
|---|
| 254 | do 280 i = 1, m
|
|---|
| 255 | temp = dfloat(i)
|
|---|
| 256 | fvec(i) = two + two*temp - dexp(temp*x(1)) - dexp(temp*x(2))
|
|---|
| 257 | 280 continue
|
|---|
| 258 | go to 430
|
|---|
| 259 | c
|
|---|
| 260 | c brown and dennis function.
|
|---|
| 261 | c
|
|---|
| 262 | 290 continue
|
|---|
| 263 | do 300 i = 1, m
|
|---|
| 264 | temp = dfloat(i)/five
|
|---|
| 265 | tmp1 = x(1) + temp*x(2) - dexp(temp)
|
|---|
| 266 | tmp2 = x(3) + dsin(temp)*x(4) - dcos(temp)
|
|---|
| 267 | fvec(i) = tmp1**2 + tmp2**2
|
|---|
| 268 | 300 continue
|
|---|
| 269 | go to 430
|
|---|
| 270 | c
|
|---|
| 271 | c chebyquad function.
|
|---|
| 272 | c
|
|---|
| 273 | 310 continue
|
|---|
| 274 | do 320 i = 1, m
|
|---|
| 275 | fvec(i) = zero
|
|---|
| 276 | 320 continue
|
|---|
| 277 | do 340 j = 1, n
|
|---|
| 278 | tmp1 = one
|
|---|
| 279 | tmp2 = two*x(j) - one
|
|---|
| 280 | temp = two*tmp2
|
|---|
| 281 | do 330 i = 1, m
|
|---|
| 282 | fvec(i) = fvec(i) + tmp2
|
|---|
| 283 | ti = temp*tmp2 - tmp1
|
|---|
| 284 | tmp1 = tmp2
|
|---|
| 285 | tmp2 = ti
|
|---|
| 286 | 330 continue
|
|---|
| 287 | 340 continue
|
|---|
| 288 | dx = one/dfloat(n)
|
|---|
| 289 | iev = -1
|
|---|
| 290 | do 350 i = 1, m
|
|---|
| 291 | fvec(i) = dx*fvec(i)
|
|---|
| 292 | if (iev .gt. 0) fvec(i) = fvec(i) + one/(dfloat(i)**2 - one)
|
|---|
| 293 | iev = -iev
|
|---|
| 294 | 350 continue
|
|---|
| 295 | go to 430
|
|---|
| 296 | c
|
|---|
| 297 | c brown almost-linear function.
|
|---|
| 298 | c
|
|---|
| 299 | 360 continue
|
|---|
| 300 | sum = -dfloat(n+1)
|
|---|
| 301 | prod = one
|
|---|
| 302 | do 370 j = 1, n
|
|---|
| 303 | sum = sum + x(j)
|
|---|
| 304 | prod = x(j)*prod
|
|---|
| 305 | 370 continue
|
|---|
| 306 | do 380 i = 1, n
|
|---|
| 307 | fvec(i) = x(i) + sum
|
|---|
| 308 | 380 continue
|
|---|
| 309 | fvec(n) = prod - one
|
|---|
| 310 | go to 430
|
|---|
| 311 | c
|
|---|
| 312 | c osborne 1 function.
|
|---|
| 313 | c
|
|---|
| 314 | 390 continue
|
|---|
| 315 | do 400 i = 1, 33
|
|---|
| 316 | temp = ten*dfloat(i-1)
|
|---|
| 317 | tmp1 = dexp(-x(4)*temp)
|
|---|
| 318 | tmp2 = dexp(-x(5)*temp)
|
|---|
| 319 | fvec(i) = y4(i) - (x(1) + x(2)*tmp1 + x(3)*tmp2)
|
|---|
| 320 | 400 continue
|
|---|
| 321 | go to 430
|
|---|
| 322 | c
|
|---|
| 323 | c osborne 2 function.
|
|---|
| 324 | c
|
|---|
| 325 | 410 continue
|
|---|
| 326 | do 420 i = 1, 65
|
|---|
| 327 | temp = dfloat(i-1)/ten
|
|---|
| 328 | tmp1 = dexp(-x(5)*temp)
|
|---|
| 329 | tmp2 = dexp(-x(6)*(temp-x(9))**2)
|
|---|
| 330 | tmp3 = dexp(-x(7)*(temp-x(10))**2)
|
|---|
| 331 | tmp4 = dexp(-x(8)*(temp-x(11))**2)
|
|---|
| 332 | fvec(i) = y5(i)
|
|---|
| 333 | * - (x(1)*tmp1 + x(2)*tmp2 + x(3)*tmp3 + x(4)*tmp4)
|
|---|
| 334 | 420 continue
|
|---|
| 335 | 430 continue
|
|---|
| 336 | return
|
|---|
| 337 | c
|
|---|
| 338 | c last card of subroutine ssqfcn.
|
|---|
| 339 | c
|
|---|
| 340 | end |
|---|
