Commit 5b989067 authored by giannozz's avatar giannozz

Added mp_get interface for complex matrices, upon request


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/[email protected] c92efa57-630b-4861-b058-cf58834340f0
parent 9ed90e18
......@@ -54,7 +54,7 @@
INTERFACE mp_get
MODULE PROCEDURE mp_get_r1, mp_get_rv, mp_get_cv, mp_get_i1, mp_get_iv, &
mp_get_rm
mp_get_rm, mp_get_cm
END INTERFACE
INTERFACE mp_put
......@@ -929,6 +929,56 @@
#endif
RETURN
END SUBROUTINE mp_get_cv
!------------------------------------------------------------------------------!
!
! Marco Govoni
!
SUBROUTINE mp_get_cm(msg_dest, msg_sour, mpime, dest, sour, ip, gid)
COMPLEX (DP) :: msg_dest(:,:), msg_sour(:,:)
INTEGER, INTENT(IN) :: dest, sour, ip, mpime
INTEGER, INTENT(IN) :: gid
INTEGER :: group
#if defined(__MPI)
INTEGER :: istatus(MPI_STATUS_SIZE)
#endif
INTEGER :: ierr, nrcv
INTEGER :: msglen
#if defined(__MPI)
group = gid
#endif
! processors not taking part in the communication have 0 length 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_COMPLEX, dest, ip, group, ierr)
IF (ierr/=0) CALL mp_stop( 8031 )
msglen = SIZE(msg_sour)
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( 8032 )
CALL MPI_GET_COUNT(istatus, MPI_DOUBLE_COMPLEX, nrcv, ierr)
IF (ierr/=0) CALL mp_stop( 8033 )
msglen = nrcv
END IF
#endif
ELSEIF(mpime .EQ. sour)THEN
msg_dest(1:SIZE(msg_sour,1), 1:SIZE(msg_sour,2)) = msg_sour(:,:)
msglen = SIZE( msg_sour )
END IF
#if defined(__MPI)
CALL MPI_BARRIER(group, IERR)
IF (ierr/=0) CALL mp_stop( 8034 )
#endif
RETURN
END SUBROUTINE mp_get_cm
!------------------------------------------------------------------------------!
!
!
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment