9875
9876
9877
9878
9879
9880
9881
9882 INTEGER ICTXT, IPOST, IPRE, LDA, M, N
9883 COMPLEX*16 CHKVAL
9884
9885
9886 CHARACTER*(*) MESS
9887 COMPLEX*16 A( * )
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
9961
9962 CHARACTER*1 TOP
9963 INTEGER I, IAM, IDUMM, INFO, J, K, MYCOL, MYROW, NPCOL,
9964 $ NPROW
9965
9966
9967 EXTERNAL blacs_gridinfo, igamx2d, pb_topget
9968
9969
9970 INTRINSIC dble, dimag
9971
9972
9973
9974
9975
9976 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
9977 iam = myrow*npcol + mycol
9978 info = -1
9979
9980
9981
9982 IF( ipre.GT.0 ) THEN
9983 DO 10 i = 1, ipre
9984 IF( a( i ).NE.chkval ) THEN
9985 WRITE( *, fmt = 9998 ) myrow, mycol, mess, ' pre', i,
9986 $ dble( a( i ) ), dimag( a( i ) )
9987 info = iam
9988 END IF
9989 10 CONTINUE
9990 ELSE
9991 WRITE( *, fmt = * ) 'WARNING no pre-guardzone in PB_ZCHEKPAD'
9992 END IF
9993
9994
9995
9996 IF( ipost.GT.0 ) THEN
9997 j = ipre+lda*n+1
9998 DO 20 i = j, j+ipost-1
9999 IF( a( i ).NE.chkval ) THEN
10000 WRITE( *, fmt = 9998 ) myrow, mycol, mess, 'post',
10001 $ i-j+1, dble( a( i ) ),
10002 $ dimag( a( i ) )
10003 info = iam
10004 END IF
10005 20 CONTINUE
10006 ELSE
10007 WRITE( *, fmt = * )
10008 $ 'WARNING no post-guardzone buffer in PB_ZCHEKPAD'
10009 END IF
10010
10011
10012
10013 IF( lda.GT.m ) THEN
10014 k = ipre + m + 1
10015 DO 40 j = 1, n
10016 DO 30 i = k, k + (lda-m) - 1
10017 IF( a( i ).NE.chkval ) THEN
10018 WRITE( *, fmt = 9997 ) myrow, mycol, mess,
10019 $ i-ipre-lda*(j-1), j, dble( a( i ) ),
10020 $ dimag( a( i ) )
10021 info = iam
10022 END IF
10023 30 CONTINUE
10024 k = k + lda
10025 40 CONTINUE
10026 END IF
10027
10028 CALL pb_topget( ictxt, 'Combine', 'All', top )
10029 CALL igamx2d( ictxt, 'All', top, 1, 1, info, 1, idumm, idumm, -1,
10030 $ 0, 0 )
10031 IF( iam.EQ.0 .AND. info.GE.0 ) THEN
10032 WRITE( *, fmt = 9999 ) info / npcol, mod( info, npcol ), mess
10033 END IF
10034
10035 9999 FORMAT( '{', i5, ',', i5, '}: Memory overwrite in ', a )
10036 9998 FORMAT( '{', i5, ',', i5, '}: ', a, ' memory overwrite in ',
10037 $ a4, '-guardzone: loc(', i3, ') = ', g20.7, '+ i*',
10038 $ g20.7 )
10039 9997 FORMAT( '{', i5, ',', i5, '}: ', a, ' memory overwrite in ',
10040 $ 'lda-m gap: loc(', i3, ',', i3, ') = ', g20.7,
10041 $ '+ i*', g20.7 )
10042
10043 RETURN
10044
10045
10046