3
4
5
6
7
8
9
10 INTEGER ICTXT, IPOST, IPRE, LDA, M, N
11 COMPLEX CHKVAL
12
13
14 CHARACTER MESS*(*)
15 COMPLEX A( * )
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81 INTEGER I, IAM, IDUMM, INFO, J, K, MYCOL, MYROW,
82 $ NPCOL, NPROW
83
84
85 EXTERNAL blacs_gridinfo, igamx2d
86
87
88 INTRINSIC real, aimag
89
90
91
92
93
94 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
95 iam = myrow*npcol + mycol
96 info = -1
97
98
99
100 IF( ipre.GT.0 ) THEN
101 DO 10 i = 1, ipre
102 IF( a( i ).NE.chkval ) THEN
103 WRITE( *, fmt = 9998 ) myrow, mycol, mess, ' pre', i,
104 $ real( a( i ) ), aimag( a( i ) )
105 info = iam
106 END IF
107 10 CONTINUE
108 ELSE
109 WRITE( *, fmt = * ) 'WARNING no pre-guardzone in PCCHEKPAD'
110 END IF
111
112
113
114 IF( ipost.GT.0 ) THEN
115 j = ipre+lda*n+1
116 DO 20 i = j, j+ipost-1
117 IF( a( i ).NE.chkval ) THEN
118 WRITE( *, fmt = 9998 ) myrow, mycol, mess, 'post',
119 $ i-j+1, real( a( i ) ),
120 $ aimag( a( i ) )
121 info = iam
122 END IF
123 20 CONTINUE
124 ELSE
125 WRITE( *, fmt = * )
126 $ 'WARNING no post-guardzone buffer in PCCHEKPAD'
127 END IF
128
129
130
131 IF( lda.GT.m ) THEN
132 k = ipre + m + 1
133 DO 40 j = 1, n
134 DO 30 i = k, k + (lda-m) - 1
135 IF( a( i ).NE.chkval ) THEN
136 WRITE( *, fmt = 9997 ) myrow, mycol, mess,
137 $ i-ipre-lda*(j-1), j, real( a( i ) ),
138 $ aimag( a( i ) )
139 info = iam
140 END IF
141 30 CONTINUE
142 k = k + lda
143 40 CONTINUE
144 END IF
145
146 CALL igamx2d( ictxt, 'All', ' ', 1, 1, info, 1, idumm, idumm, -1,
147 $ 0, 0 )
148 IF( iam.EQ.0 .AND. info.GE.0 ) THEN
149 WRITE( *, fmt = 9999 ) info / npcol, mod( info, npcol ), mess
150 END IF
151
152 9999 FORMAT( '{', i5, ',', i5, '}: Memory overwrite in ', a )
153 9998 FORMAT( '{', i5, ',', i5, '}: ', a, ' memory overwrite in ',
154 $ a4, '-guardzone: loc(', i3, ') = ', g11.4, '+ i*',
155 $ g11.4 )
156 9997 FORMAT( '{', i5, ',', i5, '}: ', a, ' memory overwrite in ',
157 $ 'lda-m gap: loc(', i3, ',', i3, ') = ', g11.4,
158 $ '+ i*', g11.4 )
159
160 RETURN
161
162
163