- fixed the bug related to msglen in mp_get and mp_put

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@4430 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
cavazzon 2007-11-13 11:43:06 +00:00
parent c67ed4338e
commit 4cac89b444
1 changed files with 149 additions and 119 deletions

View File

@ -889,13 +889,16 @@
IF( PRESENT( gid ) ) group = gid
#endif
! processors not taking part in the communication have 0 lenght message
msglen = 0
IF(dest .NE. sour) THEN
#if defined(__MPI)
IF(mpime .EQ. sour) THEN
CALL MPI_SEND( msg_sour, msglen, MPI_INTEGER, dest, ip, group, ierr)
IF (ierr/=0) CALL mp_stop( 8060 )
END IF
IF(mpime .EQ. dest) THEN
ELSE IF(mpime .EQ. dest) THEN
CALL MPI_RECV( msg_dest, msglen, MPI_INTEGER, sour, ip, group, istatus, IERR )
IF (ierr/=0) CALL mp_stop( 8061 )
CALL MPI_GET_COUNT(istatus, MPI_INTEGER, nrcv, ierr)
@ -910,6 +913,7 @@
CALL MPI_BARRIER(group, IERR)
IF (ierr/=0) CALL mp_stop( 8063 )
#endif
mp_high_watermark = MAX( mp_high_watermark, 4 * msglen )
mp_call_count( 20 ) = mp_call_count( 20 ) + 1
mp_call_sizex( 20 ) = MAX( mp_call_sizex( 20 ), msglen )
@ -937,14 +941,17 @@
IF( PRESENT( gid ) ) group = gid
#endif
! processors not taking part in the communication have 0 lenght message
msglen = 0
IF(sour .NE. dest) THEN
#if defined(__MPI)
IF(mpime .EQ. sour) THEN
msglen = SIZE(msg_sour)
CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_INTEGER, dest, ip, group, ierr)
IF (ierr/=0) CALL mp_stop( 8064 )
END IF
IF(mpime .EQ. dest) THEN
ELSE IF(mpime .EQ. dest) THEN
CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_INTEGER, sour, ip, group, istatus, IERR )
IF (ierr/=0) CALL mp_stop( 8065 )
CALL MPI_GET_COUNT(istatus, MPI_INTEGER, nrcv, ierr)
@ -982,20 +989,22 @@
INTEGER :: ierr, nrcv
INTEGER :: msglen
msglen=0
#if defined(__MPI)
group = mpi_comm_world
IF( PRESENT( gid ) ) group = gid
#endif
! processors not taking part in the communication have 0 lenght message
msglen = 0
IF(sour .NE. dest) THEN
#if defined(__MPI)
IF(mpime .EQ. sour) THEN
msglen = SIZE(msg_sour)
CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_DOUBLE_PRECISION, dest, ip, group, ierr)
IF (ierr/=0) CALL mp_stop( 8069 )
END IF
IF(mpime .EQ. dest) THEN
ELSE IF(mpime .EQ. dest) THEN
CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_DOUBLE_PRECISION, sour, ip, group, istatus, IERR )
IF (ierr/=0) CALL mp_stop( 8070 )
CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_PRECISION, nrcv, ierr)
@ -1041,14 +1050,17 @@
IF( PRESENT( gid ) ) group = gid
#endif
! processors not taking part in the communication have 0 lenght message
msglen = 0
IF(sour .NE. dest) THEN
#if defined(__MPI)
IF(mpime .EQ. sour) THEN
CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_DOUBLE_PRECISION, dest, ip, group, ierr)
IF (ierr/=0) CALL mp_stop( 8074 )
msglen = SIZE(msg_sour)
END IF
IF(mpime .EQ. dest) THEN
ELSE IF(mpime .EQ. dest) THEN
CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_DOUBLE_PRECISION, sour, ip, group, istatus, IERR )
IF (ierr/=0) CALL mp_stop( 8075 )
CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_PRECISION, nrcv, ierr)
@ -1092,14 +1104,17 @@
IF( PRESENT( gid ) ) group = gid
#endif
! processors not taking part in the communication have 0 lenght message
msglen = 0
IF( dest .NE. sour ) THEN
#if defined(__MPI)
IF(mpime .EQ. sour) THEN
CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_DOUBLE_COMPLEX, dest, ip, group, ierr)
IF (ierr/=0) CALL mp_stop( 8079 )
msglen = SIZE(msg_sour)
END IF
IF(mpime .EQ. dest) THEN
ELSE IF(mpime .EQ. dest) THEN
CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_DOUBLE_COMPLEX, sour, ip, group, istatus, IERR )
IF (ierr/=0) CALL mp_stop( 8080 )
CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_COMPLEX, nrcv, ierr)
@ -1143,14 +1158,17 @@
IF( PRESENT( gid ) ) group = gid
#endif
! processors not taking part in the communication have 0 lenght message
msglen = 0
IF(dest .NE. sour) THEN
#if defined(__MPI)
IF(mpime .EQ. sour) THEN
CALL MPI_SEND( msg_sour, 1, MPI_INTEGER, dest, ip, group, ierr)
IF (ierr/=0) CALL mp_stop( 8084 )
msglen = 1
END IF
IF(mpime .EQ. dest) THEN
ELSE IF(mpime .EQ. dest) THEN
CALL MPI_RECV( msg_dest, 1, MPI_INTEGER, sour, ip, group, istatus, IERR )
IF (ierr/=0) CALL mp_stop( 8085 )
CALL MPI_GET_COUNT(istatus, MPI_INTEGER, nrcv, ierr)
@ -1190,14 +1208,17 @@
group = mpi_comm_world
IF( PRESENT( gid ) ) group = gid
#endif
! processors not taking part in the communication have 0 lenght message
msglen = 0
IF(sour .NE. dest) THEN
#if defined(__MPI)
IF(mpime .EQ. sour) THEN
CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_INTEGER, dest, ip, group, ierr)
IF (ierr/=0) CALL mp_stop( 8089 )
msglen = SIZE(msg_sour)
END IF
IF(mpime .EQ. dest) THEN
ELSE IF(mpime .EQ. dest) THEN
CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_INTEGER, sour, ip, group, istatus, IERR )
IF (ierr/=0) CALL mp_stop( 8090 )
CALL MPI_GET_COUNT(istatus, MPI_INTEGER, nrcv, ierr)
@ -1237,14 +1258,17 @@
group = mpi_comm_world
IF( PRESENT( gid ) ) group = gid
#endif
! processors not taking part in the communication have 0 lenght message
msglen = 0
IF(sour .NE. dest) THEN
#if defined(__MPI)
IF(mpime .EQ. sour) THEN
CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_DOUBLE_PRECISION, dest, ip, group, ierr)
IF (ierr/=0) CALL mp_stop( 8094 )
msglen = SIZE(msg_sour)
END IF
IF(mpime .EQ. dest) THEN
ELSE IF(mpime .EQ. dest) THEN
CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_DOUBLE_PRECISION, sour, ip, group, istatus, IERR )
IF (ierr/=0) CALL mp_stop( 8095 )
CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_PRECISION, nrcv, ierr)
@ -1284,14 +1308,17 @@
group = mpi_comm_world
IF( PRESENT( gid ) ) group = gid
#endif
! processors not taking part in the communication have 0 lenght message
msglen = 0
IF(sour .NE. dest) THEN
#if defined(__MPI)
IF(mpime .EQ. sour) THEN
CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_DOUBLE_PRECISION, dest, ip, group, ierr)
IF (ierr/=0) CALL mp_stop( 8099 )
msglen = SIZE(msg_sour)
END IF
IF(mpime .EQ. dest) THEN
ELSE IF(mpime .EQ. dest) THEN
CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_DOUBLE_PRECISION, sour, ip, group, istatus, IERR )
IF (ierr/=0) CALL mp_stop( 8100 )
CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_PRECISION, nrcv, ierr)
@ -1332,14 +1359,17 @@
group = mpi_comm_world
IF( PRESENT( gid ) ) group = gid
#endif
! processors not taking part in the communication have 0 lenght message
msglen = 0
IF( dest .NE. sour ) THEN
#if defined(__MPI)
IF(mpime .EQ. sour) THEN
CALL MPI_SEND( msg_sour, SIZE(msg_sour), MPI_DOUBLE_COMPLEX, dest, ip, group, ierr)
IF (ierr/=0) CALL mp_stop( 8104 )
msglen = SIZE(msg_sour)
END IF
IF(mpime .EQ. dest) THEN
ELSE IF(mpime .EQ. dest) THEN
CALL MPI_RECV( msg_dest, SIZE(msg_dest), MPI_DOUBLE_COMPLEX, sour, ip, group, istatus, IERR )
IF (ierr/=0) CALL mp_stop( 8105 )
CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_COMPLEX, nrcv, ierr)