root / synthbench / euroben-ports / base / Fortran-MPI / mod2a / .svn / text-base / check.f.svn-base @ 0:839f52ef7657
History | View | Annotate | Download (3.1 kB)
1 |
Subroutine check( rname, mode, y, ychk, lchk ) |
---|---|
2 |
! --------------------------------------------------------------------- |
3 |
! --- This is a routine that checks specifically for the correct |
4 |
! operation of the Matrix-vector multiply routines in program |
5 |
! 'gmxv'. The matrix 'A' and the vector 'x' have the following |
6 |
! structure: |
7 |
! A: n x: |
8 |
! __________/\______________ |
9 |
! / \ |
10 |
! _ _ _ _ _ \ |
11 |
! / | 1 1 1 1 . . . | | 1 | | |
12 |
! | | 1 2 3 4 . . . | | 1 | | |
13 |
! / | 1 3 5 7 . . . | | 1 | | |
14 |
! m \ | 1 4 7 10 . . . | | 1 | | |
15 |
! | | . . . . . . . | | 1 | | |
16 |
! \ | . . . . . . . | | 1 | | |
17 |
! -------------------------------------------- | |
18 |
! / | 1 m+1 2m-1 3m-2 . . . | | 2 | \ Each of the |
19 |
! | | 1 m+2 2m+1 3m+1 . . . | | 2 | / 'nodes' proc.'s |
20 |
! / | 1 m+3 2m+3 3m+4 . . . | | 2 | | contains a m x n |
21 |
! m \ | 1 m+4 2m+5 3m+7 . . . | | 2 | | strip of A and |
22 |
! | | . . . . . . . | | 2 | | the full vector x. |
23 |
! \ | . . . . . . . | | 2 | | |
24 |
! -------------------------------------------- | |
25 |
! . . | |
26 |
! . . | |
27 |
! . . / |
28 |
! |
29 |
! Vector 'y' should have elements that have values as |
30 |
! specified in routine 'mkbnds'. For each part of 'y' this |
31 |
! condition is checked. If some part of 'y' is not meeting |
32 |
! this condition, a message is printed with the number of the node |
33 |
! where the incorrect result was found and the value of the |
34 |
! offending entry. |
35 |
! |
36 |
! NOTE: m can have DIFFERENT values for DIFFERENT nodes! |
37 |
! These values are known via the array 'sizes' in Module |
38 |
! dist_module. |
39 |
! --------------------------------------------------------------------- |
40 |
Use dist_module |
41 |
Use numerics |
42 |
Character :: rname*6, mode*1 |
43 |
Integer :: lchk(*) |
44 |
Real(l_) :: y(*), ychk(*) |
45 |
|
46 |
Real(l_) :: dmacdp, eps |
47 |
Logical :: ok |
48 |
Integer :: i |
49 |
! --------------------------------------------------------------------- |
50 |
ok = .TRUE. |
51 |
eps = Dble( nodes*sizes(me) )*dmacdp( 1 ) |
52 |
Do i = 1, sizes(me) |
53 |
lchk(i) = 0 |
54 |
ok = ok .AND. ( Abs ( y(i) - ychk(i) ) < eps ) |
55 |
If ( .NOT. ok ) lchk(i) = i |
56 |
End Do |
57 |
If ( .NOT. ok ) Then |
58 |
Print *, '**** For routine ' , rname, ' with mode ', mode |
59 |
Print *, 'Incorrect value(s) were found in the ' |
60 |
Print *, 'result vector in node ', me |
61 |
Do i = 1, sizes(me) |
62 |
If ( lchk(i) /= 0 ) Print 1000, me, i, y(i), ychk(i) |
63 |
End Do |
64 |
End If |
65 |
! --------------------------------------------------------------------- |
66 |
1000 Format( 'Node:', I5, 2X, 'Row:', I3, 2X, G13.5, |
67 |
& ' y(i) should be: ', G13.5 ) |
68 |
! --------------------------------------------------------------------- |
69 |
End Subroutine check |