Skip to content

Commit c1a9c19

Browse files
committed
Improved program to actually perform checks and report on them (and errors if found)
1 parent adfe2d2 commit c1a9c19

File tree

1 file changed

+23
-7
lines changed

1 file changed

+23
-7
lines changed

scripts/FWMP/FWMP_constraints.f95

+23-7
Original file line numberDiff line numberDiff line change
@@ -73,6 +73,10 @@ program FWMP_constraints
7373
! sums in paper formulas
7474
integer :: sums(4)
7575

76+
! tensor constraint checks
77+
integer :: n_tensor_checks, n_errors
78+
logical :: check_constraints
79+
7680
print *
7781
print *, "### Full Work Model Problem Example"
7882
print *
@@ -158,9 +162,11 @@ program FWMP_constraints
158162

159163
! generate integer communication tensor relations
160164
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
164170
! iterate over tensor slices
165171
do mm = 1, M
166172
! iterate over from rank indices
@@ -191,12 +197,16 @@ program FWMP_constraints
191197
psi_ub1_i(ii,jj,mm) = sums(2)
192198
psi_ub2_i(ii,jj,mm) = sums(3)
193199
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), &
195204
& 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
197207
end do ! jj
198208
end do ! ii
199-
print *, " --------------------------------------------------"
209+
print *, " -------------------------------------------------------"
200210
end do ! mm
201211

202212
! print tensor bounds
@@ -212,6 +222,8 @@ program FWMP_constraints
212222
call print_integer_matrix("psi_ub2::"//trim(int_to_str(mm)), psi_ub2_i(:,:,mm))
213223
end do
214224
print *
225+
print *, "# Verified ", trim(int_to_str(n_tensor_checks)), " tensor constraints"
226+
print *
215227

216228
! terminate program
217229
deallocate(psi_ub2_i)
@@ -229,7 +241,11 @@ program FWMP_constraints
229241
deallocate(phi_l)
230242
deallocate(u_i)
231243
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
233249
print *
234250

235251
contains

0 commit comments

Comments
 (0)