9873
9874
9875
9876
9877
9878
9879
9880 INTEGER ICTXT, IPOST, IPRE, LDA, M, N
9881 COMPLEX CHKVAL
9882
9883
9884 CHARACTER*(*) MESS
9885 COMPLEX A( * )
9886
9887
9888
9889
9890
9891
9892
9893
9894
9895
9896
9897
9898
9899
9900
9901
9902
9903
9904
9905
9906
9907
9908
9909
9910
9911
9912
9913
9914
9915
9916
9917
9918
9919
9920
9921
9922
9923
9924
9925
9926
9927
9928
9929
9930
9931
9932
9933
9934
9935
9936
9937
9938
9939
9940
9941
9942
9943
9944
9945
9946
9947
9948
9949
9950
9951
9952
9953
9954
9955
9956
9957
9958
9959
9960 CHARACTER*1 TOP
9961 INTEGER I, IAM, IDUMM, INFO, J, K, MYCOL, MYROW, NPCOL,
9962 $ NPROW
9963
9964
9965 EXTERNAL blacs_gridinfo, igamx2d, pb_topget
9966
9967
9968 INTRINSIC aimag, real
9969
9970
9971
9972
9973
9974 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
9975 iam = myrow*npcol + mycol
9976 info = -1
9977
9978
9979
9980 IF( ipre.GT.0 ) THEN
9981 DO 10 i = 1, ipre
9982 IF( a( i ).NE.chkval ) THEN
9983 WRITE( *, fmt = 9998 ) myrow, mycol, mess, ' pre', i,
9984 $ real( a( i ) ), aimag( a( i ) )
9985 info = iam
9986 END IF
9987 10 CONTINUE
9988 ELSE
9989 WRITE( *, fmt = * ) 'WARNING no pre-guardzone in PB_CCHEKPAD'
9990 END IF
9991
9992
9993
9994 IF( ipost.GT.0 ) THEN
9995 j = ipre+lda*n+1
9996 DO 20 i = j, j+ipost-1
9997 IF( a( i ).NE.chkval ) THEN
9998 WRITE( *, fmt = 9998 ) myrow, mycol, mess, 'post',
9999 $ i-j+1, real( a( i ) ),
10000 $ aimag( a( i ) )
10001 info = iam
10002 END IF
10003 20 CONTINUE
10004 ELSE
10005 WRITE( *, fmt = * )
10006 $ 'WARNING no post-guardzone buffer in PB_CCHEKPAD'
10007 END IF
10008
10009
10010
10011 IF( lda.GT.m ) THEN
10012 k = ipre + m + 1
10013 DO 40 j = 1, n
10014 DO 30 i = k, k + (lda-m) - 1
10015 IF( a( i ).NE.chkval ) THEN
10016 WRITE( *, fmt = 9997 ) myrow, mycol, mess,
10017 $ i-ipre-lda*(j-1), j, real( a( i ) ),
10018 $ aimag( a( i ) )
10019 info = iam
10020 END IF
10021 30 CONTINUE
10022 k = k + lda
10023 40 CONTINUE
10024 END IF
10025
10026 CALL pb_topget( ictxt, 'Combine', 'All', top )
10027 CALL igamx2d( ictxt, 'All', top, 1, 1, info, 1, idumm, idumm, -1,
10028 $ 0, 0 )
10029 IF( iam.EQ.0 .AND. info.GE.0 ) THEN
10030 WRITE( *, fmt = 9999 ) info / npcol, mod( info, npcol ), mess
10031 END IF
10032
10033 9999 FORMAT( '{', i5, ',', i5, '}: Memory overwrite in ', a )
10034 9998 FORMAT( '{', i5, ',', i5, '}: ', a, ' memory overwrite in ',
10035 $ a4, '-guardzone: loc(', i3, ') = ', g11.4, '+ i*',
10036 $ g11.4 )
10037 9997 FORMAT( '{', i5, ',', i5, '}: ', a, ' memory overwrite in ',
10038 $ 'lda-m gap: loc(', i3, ',', i3, ') = ', g11.4,
10039 $ '+ i*', g11.4 )
10040
10041 RETURN
10042
10043
10044