@@ -73,6 +73,10 @@ program FWMP_constraints
73
73
! sums in paper formulas
74
74
integer :: sums(4 )
75
75
76
+ ! tensor constraint checks
77
+ integer :: n_tensor_checks, n_errors
78
+ logical :: check_constraints
79
+
76
80
print *
77
81
print * , " ### Full Work Model Problem Example"
78
82
print *
@@ -158,9 +162,11 @@ program FWMP_constraints
158
162
159
163
! generate integer communication tensor relations
160
164
print * , " # Integer communication tensor relations:"
161
- print * , " ------------------------------------------------------"
162
- print * , " m j i l k w chi chiT * + lb psi ub1 ub2"
163
- print * , " ------------------------------------------------------"
165
+ print * , " ------------------------------------------------------------"
166
+ print * , " m j i l k w chi chiT * + lb psi ub1 ub2 check"
167
+ print * , " ------------------------------------------------------------"
168
+ n_tensor_checks = 0
169
+ n_errors = 0
164
170
! iterate over tensor slices
165
171
do mm = 1 , M
166
172
! iterate over from rank indices
@@ -191,12 +197,16 @@ program FWMP_constraints
191
197
psi_ub1_i(ii,jj,mm) = sums(2 )
192
198
psi_ub2_i(ii,jj,mm) = sums(3 )
193
199
psi_lb_i(ii,jj,mm) = sums(4 ) - 1
194
- print " (I38, I4, I4, I4, I4)" , sums(1 ), &
200
+ check_constraints = psi_lb_i(ii,jj,mm) <= psi_i(ii,jj,mm) .and. &
201
+ & psi_i(ii,jj,mm) <= min (psi_ub1_i(ii,jj,mm), psi_ub2_i(ii,jj,mm))
202
+ n_tensor_checks = n_tensor_checks + 3
203
+ print " (I38, I4, I4, I4, I4, L5)" , sums(1 ), &
195
204
& psi_lb_i(ii,jj,mm), psi_i(ii,jj,mm), &
196
- & psi_ub1_i(ii,jj,mm), psi_ub2_i(ii,jj,mm)
205
+ & psi_ub1_i(ii,jj,mm), psi_ub2_i(ii,jj,mm), &
206
+ & check_constraints
197
207
end do ! jj
198
208
end do ! ii
199
- print * , " --------------------------------------------------"
209
+ print * , " ------------------------------------------------------- "
200
210
end do ! mm
201
211
202
212
! print tensor bounds
@@ -212,6 +222,8 @@ program FWMP_constraints
212
222
call print_integer_matrix(" psi_ub2::" // trim (int_to_str(mm)), psi_ub2_i(:,:,mm))
213
223
end do
214
224
print *
225
+ print * , " # Verified " , trim (int_to_str(n_tensor_checks)), " tensor constraints"
226
+ print *
215
227
216
228
! terminate program
217
229
deallocate (psi_ub2_i)
@@ -229,7 +241,11 @@ program FWMP_constraints
229
241
deallocate (phi_l)
230
242
deallocate (u_i)
231
243
deallocate (u_l)
232
- print * , " Program completed without errors ###"
244
+ if (n_errors > 0 ) then
245
+ print * , " Program found " , trim (int_to_str(n_errors)), " errors ###"
246
+ else
247
+ print * , " Program completed without errors ###"
248
+ endif
233
249
print *
234
250
235
251
contains
0 commit comments