I wrote a program, whilch solve band systems with any bandwidth, which uses PDGBTRF for LU factorization and PDGBTRS for solving
But I've got an error
[n072:00748] *** Process received signal ***
[n072:00748] Signal: Segmentation fault (11)
[n072:00748] Signal code: Address not mapped (1)
[n072:00748] Failing at address: 0x34400000343
[n072:00747] *** Process received signal ***
[n072:00747] Signal: Segmentation fault (11)
[n072:00747] Signal code: Address not mapped (1)
[n072:00747] Failing at address: 0x34400000343
I want to note, that this error arrived when I tried to start on 2 processors
With 1 processor it is no problems
I found that source of this exception is PDGBTRF supposedly in second process
Here is the code of my program
- Code: Select all
PROGRAM TPDGBSV
*
* Тест к подпрограмме PDGBSV
*
include 'mpif.h'
INTEGER DLEN_, JA, IB, N, NB, RSRC, CSRC,
$ MXLLDA, MXLLDB, NRHS, NBRHS, NOUT,
$ MXLOCR, MXLOCC, MXRHSC, BWL, BWU, LWORK
$ NIN,NPCOL, NPCOLP,BWIDTH
CHARACTER TMP*80
PARAMETER ( DLEN_ = 7, JA = 1, IB = 1,
$ RSRC = 0,
$ CSRC = 0, MXLLDA = 5, MXLLDB = 3, NRHS = 1,
$ NBRHS = 1, NOUT = 6, MXLOCR = 5, MXLOCC = 3,
$ MXRHSC = 1, LWORK = 53 )
DOUBLE PRECISION HPO( 100000000 ),HPT( 100000000 )
* WRITE(6, FMT=*)'Note, that NPROW is unused for band version'
OPEN(NIN, FILE='SCAEX.dat', STATUS='OLD')
READ(NIN, FMT=*)TMP
READ(NIN, FMT=*)TMP
READ(NIN, FMT=*)TMP
READ(NIN, FMT=*)TMP
READ(NIN, FMT=*) N
READ(NIN, FMT=*)TMP
READ(NIN, FMT=*) NB *UNUSED
READ(NIN, FMT=*) NPCOL *UNUSED
READ(NIN, FMT=*) NPCOL *UNUSED
READ(NIN, FMT=*) BWIDTH
BWL = (BWIDTH - 1) / 2
BWU = (BWIDTH - 1) / 2
* WRITE(6, FMT=*)N,NB,NPCOL
* WRITE(6, FMT=*) 'BWIDTH EQUALS ',BWIDTH
CALL MYMAIN(HPO,HPT,MXLLDA,MXLOCC,MXLLDB,MXRHSC,N,BWL,BWU,NB)
STOP
END
SUBROUTINE MYMAIN (A,B,MXLLDA,MXLOCC,MXLLDB,MXRHSC,N,BWL,BWU,NB)
* Именованные константы - параметры задачи ..
INTEGER DLEN_, JA, IB, N, NB, RSRC, CSRC,
$ MXLLDA, MXLLDB, NRHS, NBRHS, NOUT,
$ MXLOCR, MXLOCC, MXRHSC, BWL, BWU, LWORK
PARAMETER ( DLEN_ = 7, JA = 1, IB = 1,
$ RSRC = 0,
$ CSRC = 0, NRHS = 1,
$ NBRHS = 1, NOUT = 6 )
DOUBLE PRECISION ONE, TIMES, TIMEE
PARAMETER ( ONE = 1.0D+0 )
*
* Локальные переменные ..
INTEGER ICTXT, INFO, MYCOL, MYROW, NPCOL, NPROW, NPROCS,
$ LAF
*
* Локальные массивы ..
INTEGER DESCA( DLEN_ ),DESCB( DLEN_ ),IPIV(NB)
* DOUBLE PRECISION A( MXLLDA, MXLOCC ),B( MXLLDB, MXRHSC ),
DOUBLE PRECISION A(1+2*BWL+2*BWU,NB ), B(NB ),
$ WORK((NB+BWU)*(BWL+BWU)+6*(BWL+BWU)*(BWL+2*BWU)),
$ AF((NB+BWU)*(BWL+BWU)+6*(BWL+BWU)*(BWL+2*BWU))
*
* Внешние подпрограммы ..
EXTERNAL BLACS_EXIT, BLACS_GRIDEXIT, BLACS_GRIDINFO,
$ MATINIT, PDGEMM, PDGBSV, SL_INIT
*
* Операторы DATA ..
*
* Выполнимые операторы ..
*
* Инициализация решетки процессов
*
LWORK = (NB+BWU)*(BWL+BWU)+6*(BWL+BWU)*(BWL+2*BWU)
LAF = LWORK
CALL BLACS_PINFO(ICTXT, NPROCS )
NPROW = 1
NPCOL = NPROCS
CALL SL_INIT( ICTXT, NPROW, NPCOL )
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
* NB = N / NPROCS
* Если процесс вне решетки процессов, переход на конец программы
*
IF( MYROW.EQ.-1 ) GO TO 10
*
* Распределение матрицы по решетке процессов
*
* Инициализация дескрипторов для матриц A и B
*
DESCA(1) = 501
DESCA(2) = ICTXT
DESCA(3) = N
IF( MYCOL.EQ.(NPROCS - 1).AND.MOD(N,NB).NE.0 ) THEN
WRITE( NOUT, FMT = * )'Shit found ', MOD(N,NB)
DESCA(4) = NB - MOD(N,NB)
ELSE
DESCA(4) = NB
END IF
DESCA(5) = CSRC
DESCA(6) = 1+2*BWL+2*BWU
DESCA(7) = 0
*
DESCB(1) = 502
DESCB(2) = ICTXT
DESCB(3) = N
IF( MYCOL.EQ.(NPROCS - 1).AND.MOD(N,NB).NE.0 ) THEN
WRITE( NOUT, FMT = * )'Shit found 502', MOD(N,NB)
DESCB(4) = NB - MOD(N,NB)
ELSE
DESCB(4) = NB
END IF
DESCB(5) = RSRC
IF( MYCOL.EQ.(NPROCS - 1).AND.MOD(N,NB).NE.0 ) THEN
WRITE( NOUT, FMT = * )'Shit found 502', MOD(N,NB)
DESCB(6) = MOD(N,NB)
ELSE
DESCB(6) = NB
END IF
DESCB(7) = 0
*
* Печать входных данных
*
IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
WRITE( NOUT, FMT = * )'Обнаружено ', NPROCS, 'процессоров'
END IF
9985 FORMAT( / 7I5 /)
9988 FORMAT( / ' BWL = ', I3, ' BWU = ', I3 /)
*
CALL BLACS_BARRIER( ICTXT, 'R' )
*
* Генерация матриц A и B и распределение по решетке процессов
*
CALL MATINIT( A, DESCA, B, DESCB, BWL, BWU, NB )
*
CALL BLACS_BARRIER( ICTXT, 'R' )
****************************************************************************BAND PRINTING**********************
PRINTIT = 0
IF (PRINTIT .EQ. 1) THEN
DO 900 I=0, NPCOL
DO 950 J=1,NB
DO 960 K=1,BWL*2+1
IF( MYROW.EQ.0 .AND. MYCOL.EQ.I ) THEN
WRITE ( NOUT, FMT = * )(I)*NB*(BWL*2+1)+J*(BWL*2+1)+K,' ',A(K+(BWL*2+1),J)
END IF
CALL BLACS_BARRIER(ICTXT,'R')
960 CONTINUE
950 CONTINUE
900 CONTINUE
END IF
****************************************************************************END OF BAND PRINTING****************
*
* Вызов подпрограмм комплекса
*
* Решение линейной системы A * X = B
*
IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
WRITE( NOUT,FMT=* )'N = ',N,'NB = ',NB
END IF
* CALL PDGBSV ( N, BWL, BWU, NRHS, A, JA, DESCA, IPIV,
* $ B, IB, DESCB, WORK, LWORK, INFO)
********************************************************************************SOLVING****************************************
IF (MYROW.EQ.0 .AND. MYCOL.EQ.0) THEN
WRITE( NOUT, FMT = * ) 'LU факторизация... '
TIMES = MPI_Wtime()
END IF
CALL BLACS_BARRIER( ICTXT, 'R' )
CALL PDGBTRF( N, BWL, BWU, A(1,1), 1, DESCA, IPIV,
$ AF, LAF, WORK, LWORK, INFO )
IF (MYROW.EQ.0 .AND. MYCOL.EQ.0) THEN
TIMEE = (MPI_Wtime() - TIMES) * -MPI_Wtick()
WRITE( NOUT, FMT = * ) 'Время LU факторизации ', TIMEE * 1.0D-140
END IF
IF (INFO/=0) THEN
write(*,*) 'Info flag from PDGBTRF = ',INFO, ', Col = ',MYCOL
STOP
END IF
CALL BLACS_BARRIER( ICTXT, 'R' )
*
* Solve using the LU factorization from PDGBTRF
*
IF (MYROW.EQ.0 .AND. MYCOL.EQ.0) THEN
WRITE( NOUT, FMT = * ) 'Решение... '
TIMES = MPI_Wtime()
END IF
CALL PDGBTRS('N', N, BWL, BWU, 1, A(1,1), 1, DESCA, IPIV,
$ B(1), 1, DESCB, AF, LAF, WORK, LWORK, INFO)
IF (MYROW.EQ.0 .AND. MYCOL.EQ.0) THEN
TIMEE = (MPI_Wtime() - TIMES) * -MPI_Wtick()
WRITE( NOUT, FMT = * ) 'Время решения ', TIMEE * 1.0D-150
END IF
*****************************************************************************END OF SOLVING**************************************
IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
WRITE (NOUT, FMT=*)'Сохранение...'
END IF
CALL SAVERES(B, DESCB, NB)
IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
WRITE (NOUT, FMT=*)'Сохранено...'
END IF
9986 FORMAT('(', I3, I3,')', ' X (из B)' / 1P, 3E16.8 )
CALL BLACS_GRIDEXIT( ICTXT )
10 CONTINUE
*
* Выход из BLACS
*
CALL BLACS_EXIT( 0 )
*
9999 FORMAT( / ' Тест к подпрограмме PDGBSV' )
9998 FORMAT(/ ' Решение A X = B ,'//' где A - ленточная матрица ',
$ I2, ' на ', I2, ',' / ' разбитая на блоки',
$ ' по столбцам по', I2,' столбца в блоке' /)
9997 FORMAT( ' Пропуск на ', I2, ' процессах,',
$ ' образующих решетку размером ', I2, ' на ', I2 /)
9996 FORMAT( / ' Значение INFO = ', I6 /)
STOP
END
*
SUBROUTINE MATINIT( A, DESCA, B, DESCB, BWL, BWU, NB )
*
* Параметры - массивы ..
INTEGER DESCA( * ), DESCB( * ), NB
*
* Parameters ..
INTEGER CTXT_, N, NIN, NOUT, BWL, BWU
DOUBLE PRECISION A(1+2*BWL+2*BWU, NB ), B(NB )
PARAMETER ( CTXT_ = 2, NIN = 11, NOUT = 6 )
*
* Локальные переменные ..
INTEGER ICTXT,MXLLDA,MYCOL,MYROW,NPCOL,NPROW,FILL_IN,
$ CREAD, Q
DOUBLE PRECISION MO, T, Z
CHARACTER TEXT*25
*
* Внешние подпрограммы ..
EXTERNAL BLACS_GRIDINFO
*
* Выполнимые операторы ..
*
ICTXT = DESCA( CTXT_ )
N = DESCA( 3 )
NB = DESCA( 4 )
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
*
T = 2.0D0
Z = 0.0D0
MO = -1.0D0
IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
* WRITE( NOUT, FMT = * ) ' Чтение из файлов...'
END IF
*
* Локальные части матриц A и B для процесса (0, 0)
FILL_IN = BWL+BWU
CREAD = 0
IF(CREAD.EQ.0) THEN
OPEN(NIN,FILE='SCAEXBAND.dat', STATUS='OLD', RECL=15,
$ ACCESS='DIRECT',FORM = 'FORMATTED' )
Q = BWL + BWL + 1
DO 200 I=0,NPCOL
IF( MYROW.EQ.0 .AND. MYCOL.EQ.I ) THEN
DO 150 J=1,NB
DO 100 K=1,Q
IF ((I)*NB*Q+(J-1)*Q+K .GT. N * Q) THEN
ELSE
* write(NOUT,FMT=*)(I)*NB*Q+(J-1)*Q+K
READ ( NIN, FMT=9930, REC = I*NB*Q+(J-1)*Q+K ) TEXT
READ ( TEXT, FMT=9920) A(K+Q-1,J )
END IF
* WRITE (NOUT,FMT=*)(I)*NB*Q+(J-1)*Q+K,' ',K,' ',J,A(K+Q-1,J)
100 CONTINUE
150 CONTINUE
END IF
CALL BLACS_BARRIER(ICTXT,'R')
200 CONTINUE
CLOSE( NIN )
END IF
IF (CREAD.EQ.1) THEN
* CALL READMTXC(A,MYCOL,NPCOL,BWL,NB)
END IF
CALL BLACS_BARRIER(ICTXT,'R')
IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
WRITE(NOUT,FMT=*)'Band reading finished'
END IF
OPEN(NIN,FILE='SCAEXRHS.dat', STATUS='OLD', RECL=15,
$ ACCESS='DIRECT',FORM = 'FORMATTED' )
* READ ( NIN, FMT=9930, REC = 1 ) TEXT
DO 300 I=0,NPCOL
DO 250 J=1,NB
IF( MYROW.EQ.0 .AND. MYCOL.EQ.I ) THEN
IF((I)*NB+J .LE. N) THEN
READ( NIN, FMT=9930, REC = (I)*NB+J ) TEXT
READ ( TEXT, FMT=9920) B( J )
END IF
WRITE ( NOUT, FMT = * )J, ' ' , (I)*NB+J, ' ', B ( J )
END IF
* CALL BLACS_BARRIER(ICTXT,'R')
250 CONTINUE
300 CONTINUE
IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
* WRITE( NOUT, FMT = * ) ' Чтение завершено'
END IF
9920 FORMAT ( 3E14.5 )
9930 FORMAT ( A )
CALL BLACS_BARRIER(ICTXT,'R')
RETURN
END
SUBROUTINE SAVERES ( B, DESCB, NB)
INTEGER DESCB( * )
DOUBLE PRECISION B( NB )
INTEGER N, NB, FOUT, ICTXT
PARAMETER ( FOUT = 11 )
ICTXT = DESCB( 2 )
N = DESCB( 3 )
* NB = DESCB( 4 )
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
WRITE(6, FMT=*)'NB is ', NB
OPEN(FOUT,FILE='BANDSOL.dat',STATUS='NEW')
CLOSE(FOUT)
END IF
CALL BLACS_BARRIER(ICTXT,'R')
OPEN(FOUT,FILE='BANDSOL.dat', STATUS='OLD', RECL=16,
$ ACCESS='DIRECT',FORM = 'FORMATTED' )
DO 300 I=0,NPCOL
DO 250 J=1,NB
IF( MYROW.EQ.0 .AND. MYCOL.EQ.I ) THEN
IF((I)*NB+J .LE. N) THEN
WRITE( FOUT, FMT=9920, REC = (I)*NB+J ) B( J )
END IF
* WRITE ( NOUT, FMT = * )J, ' ' , (I)*NB+J, ' ', B ( J )
END IF
CALL BLACS_BARRIER(ICTXT,'R')
250 CONTINUE
300 CONTINUE
9920 FORMAT ( E14.7,'\n' )
RETURN
END
CentOS Linux 2.6.22 x86_64
Please, help me to solve this problem
Thanx!
