3
4
5
6
7
8
9
10 INTEGER ICTXT, IPOST, IPRE, LDA, M, N
11 REAL CHKVAL
12
13
14 CHARACTER MESS*(*)
15 REAL 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
89
90
91 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
92 iam = myrow*npcol + mycol
93 info = -1
94
95
96
97 IF( ipre.GT.0 ) THEN
98 DO 10 i = 1, ipre
99 IF( a( i ).NE.chkval ) THEN
100 WRITE( *, fmt = 9998 ) myrow, mycol, mess, ' pre', i,
101 $ a( i )
102 info = iam
103 END IF
104 10 CONTINUE
105 ELSE
106 WRITE( *, fmt = * ) 'WARNING no pre-guardzone in PSCHEKPAD'
107 END IF
108
109
110
111 IF( ipost.GT.0 ) THEN
112 j = ipre+lda*n+1
113 DO 20 i = j, j+ipost-1
114 IF( a( i ).NE.chkval ) THEN
115 WRITE( *, fmt = 9998 ) myrow, mycol, mess, 'post',
116 $ i-j+1, a( i )
117 info = iam
118 END IF
119 20 CONTINUE
120 ELSE
121 WRITE( *, fmt = * )
122 $ 'WARNING no post-guardzone buffer in PSCHEKPAD'
123 END IF
124
125
126
127 IF( lda.GT.m ) THEN
128 k = ipre + m + 1
129 DO 40 j = 1, n
130 DO 30 i = k, k + (lda-m) - 1
131 IF( a( i ).NE.chkval ) THEN
132 WRITE( *, fmt = 9997 ) myrow, mycol, mess,
133 $ i-ipre-lda*(j-1), j, a( i )
134 info = iam
135 END IF
136 30 CONTINUE
137 k = k + lda
138 40 CONTINUE
139 END IF
140
141 CALL igamx2d( ictxt, 'All', ' ', 1, 1, info, 1, idumm, idumm, -1,
142 $ 0, 0 )
143 IF( iam.EQ.0 .AND. info.GE.0 ) THEN
144 WRITE( *, fmt = 9999 ) info / npcol, mod( info, npcol ), mess
145 END IF
146
147 9999 FORMAT( '{', i5, ',', i5, '}: Memory overwrite in ', a )
148 9998 FORMAT( '{', i5, ',', i5, '}: ', a, ' memory overwrite in ',
149 $ a4, '-guardzone: loc(', i3, ') = ', g11.4 )
150 9997 FORMAT( '{', i5, ',', i5, '}: ', a, ' memory overwrite in ',
151 $ 'lda-m gap: loc(', i3, ',', i3, ') = ', g11.4 )
152
153 RETURN
154
155
156