Actual source code: chwirut2f.F90
1: ! Program usage: mpiexec -n 1 chwirut1f [-help] [all TAO options]
2: !
3: ! Description: This example demonstrates use of the TAO package to solve a
4: ! nonlinear least-squares problem on a single processor. We minimize the
5: ! Chwirut function:
6: ! sum_{i=0}^{n/2-1} ( alpha*(x_{2i+1}-x_{2i}^2)^2 + (1-x_{2i})^2)
7: !
8: ! The C version of this code is chwirut1.c
9: !
10: #include <petsc/finclude/petsctao.h>
11: module chwirut2fmodule
12: use petsctao
13: implicit none
14: PetscReal t(0:213)
15: PetscReal y(0:213)
16: PetscInt, parameter :: m = 214, n = 3
17: PetscMPIInt, parameter :: nn = n
18: PetscMPIInt rank
19: PetscMPIInt size
20: PetscMPIInt, parameter :: idle_tag = 2000, die_tag = 3000
21: PetscMPIInt, parameter :: zero = 0, one = 1
23: contains
24: subroutine InitializeData()
26: PetscInt i
27: i = 0
28: y(i) = 92.9000_PETSC_REAL_KIND; t(i) = 0.5000_PETSC_REAL_KIND; i = i + 1
29: y(i) = 78.7000_PETSC_REAL_KIND; t(i) = 0.6250_PETSC_REAL_KIND; i = i + 1
30: y(i) = 64.2000_PETSC_REAL_KIND; t(i) = 0.7500_PETSC_REAL_KIND; i = i + 1
31: y(i) = 64.9000_PETSC_REAL_KIND; t(i) = 0.8750_PETSC_REAL_KIND; i = i + 1
32: y(i) = 57.1000_PETSC_REAL_KIND; t(i) = 1.0000_PETSC_REAL_KIND; i = i + 1
33: y(i) = 43.3000_PETSC_REAL_KIND; t(i) = 1.2500_PETSC_REAL_KIND; i = i + 1
34: y(i) = 31.1000_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
35: y(i) = 23.6000_PETSC_REAL_KIND; t(i) = 2.2500_PETSC_REAL_KIND; i = i + 1
36: y(i) = 31.0500_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
37: y(i) = 23.7750_PETSC_REAL_KIND; t(i) = 2.2500_PETSC_REAL_KIND; i = i + 1
38: y(i) = 17.7375_PETSC_REAL_KIND; t(i) = 2.7500_PETSC_REAL_KIND; i = i + 1
39: y(i) = 13.8000_PETSC_REAL_KIND; t(i) = 3.2500_PETSC_REAL_KIND; i = i + 1
40: y(i) = 11.5875_PETSC_REAL_KIND; t(i) = 3.7500_PETSC_REAL_KIND; i = i + 1
41: y(i) = 9.4125_PETSC_REAL_KIND; t(i) = 4.2500_PETSC_REAL_KIND; i = i + 1
42: y(i) = 7.7250_PETSC_REAL_KIND; t(i) = 4.7500_PETSC_REAL_KIND; i = i + 1
43: y(i) = 7.3500_PETSC_REAL_KIND; t(i) = 5.2500_PETSC_REAL_KIND; i = i + 1
44: y(i) = 8.0250_PETSC_REAL_KIND; t(i) = 5.7500_PETSC_REAL_KIND; i = i + 1
45: y(i) = 90.6000_PETSC_REAL_KIND; t(i) = 0.5000_PETSC_REAL_KIND; i = i + 1
46: y(i) = 76.9000_PETSC_REAL_KIND; t(i) = 0.6250_PETSC_REAL_KIND; i = i + 1
47: y(i) = 71.6000_PETSC_REAL_KIND; t(i) = 0.7500_PETSC_REAL_KIND; i = i + 1
48: y(i) = 63.6000_PETSC_REAL_KIND; t(i) = 0.8750_PETSC_REAL_KIND; i = i + 1
49: y(i) = 54.0000_PETSC_REAL_KIND; t(i) = 1.0000_PETSC_REAL_KIND; i = i + 1
50: y(i) = 39.2000_PETSC_REAL_KIND; t(i) = 1.2500_PETSC_REAL_KIND; i = i + 1
51: y(i) = 29.3000_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
52: y(i) = 21.4000_PETSC_REAL_KIND; t(i) = 2.2500_PETSC_REAL_KIND; i = i + 1
53: y(i) = 29.1750_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
54: y(i) = 22.1250_PETSC_REAL_KIND; t(i) = 2.2500_PETSC_REAL_KIND; i = i + 1
55: y(i) = 17.5125_PETSC_REAL_KIND; t(i) = 2.7500_PETSC_REAL_KIND; i = i + 1
56: y(i) = 14.2500_PETSC_REAL_KIND; t(i) = 3.2500_PETSC_REAL_KIND; i = i + 1
57: y(i) = 9.4500_PETSC_REAL_KIND; t(i) = 3.7500_PETSC_REAL_KIND; i = i + 1
58: y(i) = 9.1500_PETSC_REAL_KIND; t(i) = 4.2500_PETSC_REAL_KIND; i = i + 1
59: y(i) = 7.9125_PETSC_REAL_KIND; t(i) = 4.7500_PETSC_REAL_KIND; i = i + 1
60: y(i) = 8.4750_PETSC_REAL_KIND; t(i) = 5.2500_PETSC_REAL_KIND; i = i + 1
61: y(i) = 6.1125_PETSC_REAL_KIND; t(i) = 5.7500_PETSC_REAL_KIND; i = i + 1
62: y(i) = 80.0000_PETSC_REAL_KIND; t(i) = 0.5000_PETSC_REAL_KIND; i = i + 1
63: y(i) = 79.0000_PETSC_REAL_KIND; t(i) = 0.6250_PETSC_REAL_KIND; i = i + 1
64: y(i) = 63.8000_PETSC_REAL_KIND; t(i) = 0.7500_PETSC_REAL_KIND; i = i + 1
65: y(i) = 57.2000_PETSC_REAL_KIND; t(i) = 0.8750_PETSC_REAL_KIND; i = i + 1
66: y(i) = 53.2000_PETSC_REAL_KIND; t(i) = 1.0000_PETSC_REAL_KIND; i = i + 1
67: y(i) = 42.5000_PETSC_REAL_KIND; t(i) = 1.2500_PETSC_REAL_KIND; i = i + 1
68: y(i) = 26.8000_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
69: y(i) = 20.4000_PETSC_REAL_KIND; t(i) = 2.2500_PETSC_REAL_KIND; i = i + 1
70: y(i) = 26.8500_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
71: y(i) = 21.0000_PETSC_REAL_KIND; t(i) = 2.2500_PETSC_REAL_KIND; i = i + 1
72: y(i) = 16.4625_PETSC_REAL_KIND; t(i) = 2.7500_PETSC_REAL_KIND; i = i + 1
73: y(i) = 12.5250_PETSC_REAL_KIND; t(i) = 3.2500_PETSC_REAL_KIND; i = i + 1
74: y(i) = 10.5375_PETSC_REAL_KIND; t(i) = 3.7500_PETSC_REAL_KIND; i = i + 1
75: y(i) = 8.5875_PETSC_REAL_KIND; t(i) = 4.2500_PETSC_REAL_KIND; i = i + 1
76: y(i) = 7.1250_PETSC_REAL_KIND; t(i) = 4.7500_PETSC_REAL_KIND; i = i + 1
77: y(i) = 6.1125_PETSC_REAL_KIND; t(i) = 5.2500_PETSC_REAL_KIND; i = i + 1
78: y(i) = 5.9625_PETSC_REAL_KIND; t(i) = 5.7500_PETSC_REAL_KIND; i = i + 1
79: y(i) = 74.1000_PETSC_REAL_KIND; t(i) = 0.5000_PETSC_REAL_KIND; i = i + 1
80: y(i) = 67.3000_PETSC_REAL_KIND; t(i) = 0.6250_PETSC_REAL_KIND; i = i + 1
81: y(i) = 60.8000_PETSC_REAL_KIND; t(i) = 0.7500_PETSC_REAL_KIND; i = i + 1
82: y(i) = 55.5000_PETSC_REAL_KIND; t(i) = 0.8750_PETSC_REAL_KIND; i = i + 1
83: y(i) = 50.3000_PETSC_REAL_KIND; t(i) = 1.0000_PETSC_REAL_KIND; i = i + 1
84: y(i) = 41.0000_PETSC_REAL_KIND; t(i) = 1.2500_PETSC_REAL_KIND; i = i + 1
85: y(i) = 29.4000_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
86: y(i) = 20.4000_PETSC_REAL_KIND; t(i) = 2.2500_PETSC_REAL_KIND; i = i + 1
87: y(i) = 29.3625_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
88: y(i) = 21.1500_PETSC_REAL_KIND; t(i) = 2.2500_PETSC_REAL_KIND; i = i + 1
89: y(i) = 16.7625_PETSC_REAL_KIND; t(i) = 2.7500_PETSC_REAL_KIND; i = i + 1
90: y(i) = 13.2000_PETSC_REAL_KIND; t(i) = 3.2500_PETSC_REAL_KIND; i = i + 1
91: y(i) = 10.8750_PETSC_REAL_KIND; t(i) = 3.7500_PETSC_REAL_KIND; i = i + 1
92: y(i) = 8.1750_PETSC_REAL_KIND; t(i) = 4.2500_PETSC_REAL_KIND; i = i + 1
93: y(i) = 7.3500_PETSC_REAL_KIND; t(i) = 4.7500_PETSC_REAL_KIND; i = i + 1
94: y(i) = 5.9625_PETSC_REAL_KIND; t(i) = 5.2500_PETSC_REAL_KIND; i = i + 1
95: y(i) = 5.6250_PETSC_REAL_KIND; t(i) = 5.7500_PETSC_REAL_KIND; i = i + 1
96: y(i) = 81.5000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
97: y(i) = 62.4000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
98: y(i) = 32.5000_PETSC_REAL_KIND; t(i) = 1.5000_PETSC_REAL_KIND; i = i + 1
99: y(i) = 12.4100_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
100: y(i) = 13.1200_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
101: y(i) = 15.5600_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
102: y(i) = 5.6300_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
103: y(i) = 78.0000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
104: y(i) = 59.9000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
105: y(i) = 33.2000_PETSC_REAL_KIND; t(i) = 1.5000_PETSC_REAL_KIND; i = i + 1
106: y(i) = 13.8400_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
107: y(i) = 12.7500_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
108: y(i) = 14.6200_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
109: y(i) = 3.9400_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
110: y(i) = 76.8000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
111: y(i) = 61.0000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
112: y(i) = 32.9000_PETSC_REAL_KIND; t(i) = 1.5000_PETSC_REAL_KIND; i = i + 1
113: y(i) = 13.8700_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
114: y(i) = 11.8100_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
115: y(i) = 13.3100_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
116: y(i) = 5.4400_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
117: y(i) = 78.0000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
118: y(i) = 63.5000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
119: y(i) = 33.8000_PETSC_REAL_KIND; t(i) = 1.5000_PETSC_REAL_KIND; i = i + 1
120: y(i) = 12.5600_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
121: y(i) = 5.6300_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
122: y(i) = 12.7500_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
123: y(i) = 13.1200_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
124: y(i) = 5.4400_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
125: y(i) = 76.8000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
126: y(i) = 60.0000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
127: y(i) = 47.8000_PETSC_REAL_KIND; t(i) = 1.0000_PETSC_REAL_KIND; i = i + 1
128: y(i) = 32.0000_PETSC_REAL_KIND; t(i) = 1.5000_PETSC_REAL_KIND; i = i + 1
129: y(i) = 22.2000_PETSC_REAL_KIND; t(i) = 2.0000_PETSC_REAL_KIND; i = i + 1
130: y(i) = 22.5700_PETSC_REAL_KIND; t(i) = 2.0000_PETSC_REAL_KIND; i = i + 1
131: y(i) = 18.8200_PETSC_REAL_KIND; t(i) = 2.5000_PETSC_REAL_KIND; i = i + 1
132: y(i) = 13.9500_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
133: y(i) = 11.2500_PETSC_REAL_KIND; t(i) = 4.0000_PETSC_REAL_KIND; i = i + 1
134: y(i) = 9.0000_PETSC_REAL_KIND; t(i) = 5.0000_PETSC_REAL_KIND; i = i + 1
135: y(i) = 6.6700_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
136: y(i) = 75.8000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
137: y(i) = 62.0000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
138: y(i) = 48.8000_PETSC_REAL_KIND; t(i) = 1.0000_PETSC_REAL_KIND; i = i + 1
139: y(i) = 35.2000_PETSC_REAL_KIND; t(i) = 1.5000_PETSC_REAL_KIND; i = i + 1
140: y(i) = 20.0000_PETSC_REAL_KIND; t(i) = 2.0000_PETSC_REAL_KIND; i = i + 1
141: y(i) = 20.3200_PETSC_REAL_KIND; t(i) = 2.0000_PETSC_REAL_KIND; i = i + 1
142: y(i) = 19.3100_PETSC_REAL_KIND; t(i) = 2.5000_PETSC_REAL_KIND; i = i + 1
143: y(i) = 12.7500_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
144: y(i) = 10.4200_PETSC_REAL_KIND; t(i) = 4.0000_PETSC_REAL_KIND; i = i + 1
145: y(i) = 7.3100_PETSC_REAL_KIND; t(i) = 5.0000_PETSC_REAL_KIND; i = i + 1
146: y(i) = 7.4200_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
147: y(i) = 70.5000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
148: y(i) = 59.5000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
149: y(i) = 48.5000_PETSC_REAL_KIND; t(i) = 1.0000_PETSC_REAL_KIND; i = i + 1
150: y(i) = 35.8000_PETSC_REAL_KIND; t(i) = 1.5000_PETSC_REAL_KIND; i = i + 1
151: y(i) = 21.0000_PETSC_REAL_KIND; t(i) = 2.0000_PETSC_REAL_KIND; i = i + 1
152: y(i) = 21.6700_PETSC_REAL_KIND; t(i) = 2.0000_PETSC_REAL_KIND; i = i + 1
153: y(i) = 21.0000_PETSC_REAL_KIND; t(i) = 2.5000_PETSC_REAL_KIND; i = i + 1
154: y(i) = 15.6400_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
155: y(i) = 8.1700_PETSC_REAL_KIND; t(i) = 4.0000_PETSC_REAL_KIND; i = i + 1
156: y(i) = 8.5500_PETSC_REAL_KIND; t(i) = 5.0000_PETSC_REAL_KIND; i = i + 1
157: y(i) = 10.1200_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
158: y(i) = 78.0000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
159: y(i) = 66.0000_PETSC_REAL_KIND; t(i) = .6250_PETSC_REAL_KIND; i = i + 1
160: y(i) = 62.0000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
161: y(i) = 58.0000_PETSC_REAL_KIND; t(i) = .8750_PETSC_REAL_KIND; i = i + 1
162: y(i) = 47.7000_PETSC_REAL_KIND; t(i) = 1.0000_PETSC_REAL_KIND; i = i + 1
163: y(i) = 37.8000_PETSC_REAL_KIND; t(i) = 1.2500_PETSC_REAL_KIND; i = i + 1
164: y(i) = 20.2000_PETSC_REAL_KIND; t(i) = 2.2500_PETSC_REAL_KIND; i = i + 1
165: y(i) = 21.0700_PETSC_REAL_KIND; t(i) = 2.2500_PETSC_REAL_KIND; i = i + 1
166: y(i) = 13.8700_PETSC_REAL_KIND; t(i) = 2.7500_PETSC_REAL_KIND; i = i + 1
167: y(i) = 9.6700_PETSC_REAL_KIND; t(i) = 3.2500_PETSC_REAL_KIND; i = i + 1
168: y(i) = 7.7600_PETSC_REAL_KIND; t(i) = 3.7500_PETSC_REAL_KIND; i = i + 1
169: y(i) = 5.4400_PETSC_REAL_KIND; t(i) = 4.2500_PETSC_REAL_KIND; i = i + 1
170: y(i) = 4.8700_PETSC_REAL_KIND; t(i) = 4.7500_PETSC_REAL_KIND; i = i + 1
171: y(i) = 4.0100_PETSC_REAL_KIND; t(i) = 5.2500_PETSC_REAL_KIND; i = i + 1
172: y(i) = 3.7500_PETSC_REAL_KIND; t(i) = 5.7500_PETSC_REAL_KIND; i = i + 1
173: y(i) = 24.1900_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
174: y(i) = 25.7600_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
175: y(i) = 18.0700_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
176: y(i) = 11.8100_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
177: y(i) = 12.0700_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
178: y(i) = 16.1200_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
179: y(i) = 70.8000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
180: y(i) = 54.7000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
181: y(i) = 48.0000_PETSC_REAL_KIND; t(i) = 1.0000_PETSC_REAL_KIND; i = i + 1
182: y(i) = 39.8000_PETSC_REAL_KIND; t(i) = 1.5000_PETSC_REAL_KIND; i = i + 1
183: y(i) = 29.8000_PETSC_REAL_KIND; t(i) = 2.0000_PETSC_REAL_KIND; i = i + 1
184: y(i) = 23.7000_PETSC_REAL_KIND; t(i) = 2.5000_PETSC_REAL_KIND; i = i + 1
185: y(i) = 29.6200_PETSC_REAL_KIND; t(i) = 2.0000_PETSC_REAL_KIND; i = i + 1
186: y(i) = 23.8100_PETSC_REAL_KIND; t(i) = 2.5000_PETSC_REAL_KIND; i = i + 1
187: y(i) = 17.7000_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
188: y(i) = 11.5500_PETSC_REAL_KIND; t(i) = 4.0000_PETSC_REAL_KIND; i = i + 1
189: y(i) = 12.0700_PETSC_REAL_KIND; t(i) = 5.0000_PETSC_REAL_KIND; i = i + 1
190: y(i) = 8.7400_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
191: y(i) = 80.7000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
192: y(i) = 61.3000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
193: y(i) = 47.5000_PETSC_REAL_KIND; t(i) = 1.0000_PETSC_REAL_KIND; i = i + 1
194: y(i) = 29.0000_PETSC_REAL_KIND; t(i) = 1.5000_PETSC_REAL_KIND; i = i + 1
195: y(i) = 24.0000_PETSC_REAL_KIND; t(i) = 2.0000_PETSC_REAL_KIND; i = i + 1
196: y(i) = 17.7000_PETSC_REAL_KIND; t(i) = 2.5000_PETSC_REAL_KIND; i = i + 1
197: y(i) = 24.5600_PETSC_REAL_KIND; t(i) = 2.0000_PETSC_REAL_KIND; i = i + 1
198: y(i) = 18.6700_PETSC_REAL_KIND; t(i) = 2.5000_PETSC_REAL_KIND; i = i + 1
199: y(i) = 16.2400_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
200: y(i) = 8.7400_PETSC_REAL_KIND; t(i) = 4.0000_PETSC_REAL_KIND; i = i + 1
201: y(i) = 7.8700_PETSC_REAL_KIND; t(i) = 5.0000_PETSC_REAL_KIND; i = i + 1
202: y(i) = 8.5100_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
203: y(i) = 66.7000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
204: y(i) = 59.2000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
205: y(i) = 40.8000_PETSC_REAL_KIND; t(i) = 1.0000_PETSC_REAL_KIND; i = i + 1
206: y(i) = 30.7000_PETSC_REAL_KIND; t(i) = 1.5000_PETSC_REAL_KIND; i = i + 1
207: y(i) = 25.7000_PETSC_REAL_KIND; t(i) = 2.0000_PETSC_REAL_KIND; i = i + 1
208: y(i) = 16.3000_PETSC_REAL_KIND; t(i) = 2.5000_PETSC_REAL_KIND; i = i + 1
209: y(i) = 25.9900_PETSC_REAL_KIND; t(i) = 2.0000_PETSC_REAL_KIND; i = i + 1
210: y(i) = 16.9500_PETSC_REAL_KIND; t(i) = 2.5000_PETSC_REAL_KIND; i = i + 1
211: y(i) = 13.3500_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
212: y(i) = 8.6200_PETSC_REAL_KIND; t(i) = 4.0000_PETSC_REAL_KIND; i = i + 1
213: y(i) = 7.2000_PETSC_REAL_KIND; t(i) = 5.0000_PETSC_REAL_KIND; i = i + 1
214: y(i) = 6.6400_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
215: y(i) = 13.6900_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
216: y(i) = 81.0000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
217: y(i) = 64.5000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
218: y(i) = 35.5000_PETSC_REAL_KIND; t(i) = 1.5000_PETSC_REAL_KIND; i = i + 1
219: y(i) = 13.3100_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
220: y(i) = 4.8700_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
221: y(i) = 12.9400_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
222: y(i) = 5.0600_PETSC_REAL_KIND; t(i) = 6.0000_PETSC_REAL_KIND; i = i + 1
223: y(i) = 15.1900_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
224: y(i) = 14.6200_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
225: y(i) = 15.6400_PETSC_REAL_KIND; t(i) = 3.0000_PETSC_REAL_KIND; i = i + 1
226: y(i) = 25.5000_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
227: y(i) = 25.9500_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
228: y(i) = 81.7000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
229: y(i) = 61.6000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
230: y(i) = 29.8000_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
231: y(i) = 29.8100_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
232: y(i) = 17.1700_PETSC_REAL_KIND; t(i) = 2.7500_PETSC_REAL_KIND; i = i + 1
233: y(i) = 10.3900_PETSC_REAL_KIND; t(i) = 3.7500_PETSC_REAL_KIND; i = i + 1
234: y(i) = 28.4000_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
235: y(i) = 28.6900_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
236: y(i) = 81.3000_PETSC_REAL_KIND; t(i) = .5000_PETSC_REAL_KIND; i = i + 1
237: y(i) = 60.9000_PETSC_REAL_KIND; t(i) = .7500_PETSC_REAL_KIND; i = i + 1
238: y(i) = 16.6500_PETSC_REAL_KIND; t(i) = 2.7500_PETSC_REAL_KIND; i = i + 1
239: y(i) = 10.0500_PETSC_REAL_KIND; t(i) = 3.7500_PETSC_REAL_KIND; i = i + 1
240: y(i) = 28.9000_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
241: y(i) = 28.9500_PETSC_REAL_KIND; t(i) = 1.7500_PETSC_REAL_KIND; i = i + 1
243: end
245: subroutine TaskWorker(ierr)
247: PetscErrorCode ierr
248: PetscReal x(n), f(1)
249: PetscMPIInt tag
250: PetscInt index
251: #if defined(PETSC_USE_MPI_F08)
252: MPIU_Status status
253: #else
254: MPIU_Status status(MPI_STATUS_SIZE)
255: #endif
256: tag = IDLE_TAG
257: f = 0.0
258: ! Send check-in message to rank-0
259: PetscCallMPI(MPI_Send(f, one, MPIU_SCALAR, zero, IDLE_TAG, PETSC_COMM_WORLD, ierr))
260: do while (tag /= DIE_TAG)
261: PetscCallMPI(MPI_Recv(x, nn, MPIU_SCALAR, zero, MPI_ANY_TAG, PETSC_COMM_WORLD, status, ierr))
262: #if defined(PETSC_USE_MPI_F08)
263: tag = status%MPI_TAG
264: #else
265: tag = status(MPI_TAG)
266: #endif
267: if (tag == IDLE_TAG) then
268: PetscCallMPI(MPI_Send(f, one, MPIU_SCALAR, zero, IDLE_TAG, PETSC_COMM_WORLD, ierr))
269: else if (tag /= DIE_TAG) then
270: index = tag
271: ! Compute local part of residual
272: PetscCall(RunSimulation(x, index, f(1), ierr))
274: ! Return residual to rank-0
275: PetscCallMPI(MPI_Send(f, one, MPIU_SCALAR, zero, tag, PETSC_COMM_WORLD, ierr))
276: end if
277: end do
278: ierr = 0
279: end
281: subroutine RunSimulation(x, i, f, ierr)
283: PetscReal x(n), f
284: PetscInt, intent(in) :: i
285: PetscErrorCode, intent(out) :: ierr
286: f = y(i) - exp(-x(1)*t(i))/(x(2) + x(3)*t(i))
287: ierr = 0
288: end
290: subroutine StopWorkers(ierr)
292: integer checkedin
293: #if defined(PETSC_USE_MPI_F08)
294: MPIU_Status status
295: #else
296: MPIU_Status status(MPI_STATUS_SIZE)
297: #endif
298: PetscMPIInt source
299: PetscReal f(1), x(n)
300: PetscErrorCode, intent(out) :: ierr
302: checkedin = 0
303: do while (checkedin < size - 1)
304: PetscCallMPI(MPI_Recv(f, one, MPIU_SCALAR, MPI_ANY_SOURCE, MPI_ANY_TAG, PETSC_COMM_WORLD, status, ierr))
305: checkedin = checkedin + 1
306: #if defined(PETSC_USE_MPI_F08)
307: source = status%MPI_SOURCE
308: #else
309: source = status(MPI_SOURCE)
310: #endif
311: x(1:n) = 0.0
312: PetscCallMPI(MPI_Send(x, nn, MPIU_SCALAR, source, DIE_TAG, PETSC_COMM_WORLD, ierr))
313: end do
314: ierr = 0
315: end
317: ! --------------------------------------------------------------------
318: ! FormFunction - Evaluates the function f(X) and gradient G(X)
319: !
320: ! Input Parameters:
321: ! tao - the Tao context
322: ! X - input vector
323: ! dummy - not used
324: !
325: ! Output Parameters:
326: ! f - function vector
328: subroutine FormFunction(ta, x, f, dummy, ierr)
330: Tao ta
331: Vec x, f
332: PetscErrorCode ierr
334: PetscInt i, checkedin
335: PetscInt finished_tasks
336: PetscMPIInt next_task
337: PetscMPIInt tag, source
338: #if defined(PETSC_USE_MPI_F08)
339: MPIU_Status status
340: #else
341: MPIU_Status status(MPI_STATUS_SIZE)
342: #endif
343: PetscInt dummy
345: PetscReal, pointer :: f_v(:), x_v(:)
346: PetscReal fval(1)
348: ierr = 0
350: ! Get pointers to vector data
351: PetscCall(VecGetArrayRead(x, x_v, ierr))
352: PetscCall(VecGetArray(f, f_v, ierr))
354: ! Compute F(X)
355: if (size == 1) then
356: ! Single processor
357: do i = 1, m
358: PetscCall(RunSimulation(x_v, i, f_v(i), ierr))
359: end do
360: else
361: ! Multiprocessor main
362: next_task = zero
363: finished_tasks = 0
364: checkedin = 0
366: do while (finished_tasks < m .or. checkedin < size - 1)
367: PetscCallMPI(MPI_Recv(fval, one, MPIU_SCALAR, MPI_ANY_SOURCE, MPI_ANY_TAG, PETSC_COMM_WORLD, status, ierr))
368: #if defined(PETSC_USE_MPI_F08)
369: tag = status%MPI_TAG
370: source = status%MPI_SOURCE
371: #else
372: tag = status(MPI_TAG)
373: source = status(MPI_SOURCE)
374: #endif
375: if (tag == IDLE_TAG) then
376: checkedin = checkedin + 1
377: else
378: f_v(tag + 1) = fval(1)
379: finished_tasks = finished_tasks + 1
380: end if
381: if (next_task < m) then
382: ! Send task to worker
383: PetscCallMPI(MPI_Send(x_v, nn, MPIU_SCALAR, source, next_task, PETSC_COMM_WORLD, ierr))
384: next_task = next_task + one
385: else
386: ! Send idle message to worker
387: PetscCallMPI(MPI_Send(x_v, nn, MPIU_SCALAR, source, IDLE_TAG, PETSC_COMM_WORLD, ierr))
388: end if
389: end do
390: end if
392: ! Restore vectors
393: PetscCall(VecRestoreArrayRead(x, x_v, ierr))
394: PetscCall(VecRestoreArray(F, f_v, ierr))
395: end
397: subroutine FormStartingPoint(x)
399: Vec x
400: PetscReal, pointer :: x_v(:)
401: PetscErrorCode ierr
403: PetscCall(VecGetArray(x, x_v, ierr))
404: x_v(1) = 0.15_PETSC_REAL_KIND
405: x_v(2) = 0.008_PETSC_REAL_KIND
406: x_v(3) = 0.01_PETSC_REAL_KIND
407: PetscCall(VecRestoreArray(x, x_v, ierr))
408: end
409: end module chwirut2fmodule
411: program main
412: use chwirut2fmodule
413: implicit none
414: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
415: ! Variable declarations
416: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
417: !
418: ! See additional variable declarations in the file chwirut2f.h
420: PetscErrorCode ierr ! used to check for functions returning nonzeros
421: Vec x ! solution vector
422: Vec f ! vector of functions
423: Tao ta ! Tao context
425: ! Initialize TAO and PETSc
426: PetscCallA(PetscInitialize(ierr))
427: PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD, size, ierr))
428: PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
430: ! Initialize problem parameters
431: call InitializeData()
433: if (rank == 0) then
434: ! Allocate vectors for the solution and gradient
435: PetscCallA(VecCreateSeq(PETSC_COMM_SELF, n, x, ierr))
436: PetscCallA(VecCreateSeq(PETSC_COMM_SELF, m, f, ierr))
438: ! The TAO code begins here
440: ! Create TAO solver
441: PetscCallA(TaoCreate(PETSC_COMM_SELF, ta, ierr))
442: PetscCallA(TaoSetType(ta, TAOPOUNDERS, ierr))
444: ! Set routines for function, gradient, and hessian evaluation
445: PetscCallA(TaoSetResidualRoutine(ta, f, FormFunction, 0, ierr))
447: ! Optional: Set initial guess
448: call FormStartingPoint(x)
449: PetscCallA(TaoSetSolution(ta, x, ierr))
451: ! Check for TAO command line options
452: PetscCallA(TaoSetFromOptions(ta, ierr))
453: ! SOLVE THE APPLICATION
454: PetscCallA(TaoSolve(ta, ierr))
456: ! Free TAO data structures
457: PetscCallA(TaoDestroy(ta, ierr))
459: ! Free PETSc data structures
460: PetscCallA(VecDestroy(x, ierr))
461: PetscCallA(VecDestroy(f, ierr))
462: PetscCallA(StopWorkers(ierr))
464: else
465: PetscCallA(TaskWorker(ierr))
466: end if
468: PetscCallA(PetscFinalize(ierr))
469: end
470: !/*TEST
471: !
472: ! build:
473: ! requires: !complex
474: !
475: ! test:
476: ! nsize: 3
477: ! args: -tao_monitor_short -tao_max_it 100 -tao_type pounders -tao_gatol 1.e-5
478: ! requires: !single
479: !
480: !
481: !TEST*/