MODULE MPIUTILS
IMPLICIT NONE
INCLUDE "mpif.h"

INTERFACE MPISEND
	MODULE PROCEDURE MPISEND_STR,MPISEND_INT,MPISEND_INTARR,MPISEND_REAL,MPISEND_REALARR &
	,MPISEND_DBLE,MPISEND_DBLEARR,MPISEND_CMPLX,MPISEND_CMPLXARR,MPISEND_LOGICAL,MPISEND_LOGICALARR
END INTERFACE
!! MPISEND(INTEGER destination, INTEGER tag, ANTTYPE msg, OPTIONAL INTEGER string_length)
!! send msg to destination with tag
!! msg can be string (in such case you can specify string_length), integer (array), real (array),
!! doubleprecision (array), complex (array) or logical (array)

INTERFACE MPIRECV
	MODULE PROCEDURE MPIRECV_STR,MPIRECV_INT,MPIRECV_INTARR,MPIRECV_REAL,MPIRECV_REALARR &
	,MPIRECV_DBLE,MPIRECV_DBLEARR,MPIRECV_CMPLX,MPIRECV_CMPLXARR,MPIRECV_LOGICAL,MPIRECV_LOGICALARR
END INTERFACE
!! MPIRECV(INTEGER source, INTEGER tag, ANYTYPE msg, OPTIONAL INTEGER string_length)
!! recieve msg from source with tag
!! msg can be string (in such case you can specify string_length), integer (array), real (array),
!! doubleprecision (array), complex (array) or logical (array)
!! return: msg

INTERFACE MPIRECVANYSOURCE
	MODULE PROCEDURE MPIRECVANYSOURCE_STR,MPIRECVANYSOURCE_INT,MPIRECVANYSOURCE_INTARR,MPIRECVANYSOURCE_REAL,MPIRECVANYSOURCE_REALARR &
	,MPIRECVANYSOURCE_DBLE,MPIRECVANYSOURCE_DBLEARR,MPIRECVANYSOURCE_CMPLX,MPIRECVANYSOURCE_CMPLXARR,MPIRECVANYSOURCE_LOGICAL,MPIRECVANYSOURCE_LOGICALARR
END INTERFACE
!! MPIRECVANYSOURCE(INTEGER anysource, INTEGER tag, ANYTYPE msg, OPTIONAL INTEGER string_length)
!! receive msg from any source with tag
!! return: source (stored in anysource) and msg

INTERFACE MPIRECVANYTAG
	MODULE PROCEDURE MPIRECVANYTAG_STR,MPIRECVANYTAG_INT,MPIRECVANYTAG_INTARR,MPIRECVANYTAG_REAL,MPIRECVANYTAG_REALARR &
	,MPIRECVANYTAG_DBLE,MPIRECVANYTAG_DBLEARR,MPIRECVANYTAG_CMPLX,MPIRECVANYTAG_CMPLXARR,MPIRECVANYTAG_LOGICAL,MPIRECVANYTAG_LOGICALARR
END INTERFACE
!! MPIRECVANYTAG(INTEGER source, INTEGER anytag, ANYTYPE msg, OPTIONAL INTEGER string_length)
!! receive msg from source with any tag
!! return: tag (stored in anytag) and msg

INTERFACE MPIRECVANY
	MODULE PROCEDURE MPIRECVANY_STR,MPIRECVANY_INT,MPIRECVANY_INTARR,MPIRECVANY_REAL,MPIRECVANY_REALARR &
	,MPIRECVANY_DBLE,MPIRECVANY_DBLEARR,MPIRECVANY_CMPLX,MPIRECVANY_CMPLXARR,MPIRECVANY_LOGICAL,MPIRECVANY_LOGICALARR
END INTERFACE
!! MPIRECVANY(INTEGER anysource, INTEGER anytag, ANYTYPE msg, OPTIONAL INTEGER string_length)
!! receive msg from any source with any tag
!! return: source (stored in anysource), tag (stored in anytag) and msg

INTERFACE MPIBCAST
	MODULE PROCEDURE MPIBCAST_STR,MPIBCAST_INT,MPIBCAST_INTARR,MPIBCAST_REAL,MPIBCAST_REALARR &
	,MPIBCAST_DBLE,MPIBCAST_DBLEARR,MPIBCAST_CMPLX,MPIBCAST_CMPLXARR,MPIBCAST_LOGICAL,MPIBCAST_LOGICALARR
END INTERFACE
!!MPIBCAST(ANYTYPE msg,OPTIONAL INTEGER root)
!! broadcast msg from node #root(or 0 if root is omitted).

INTERFACE MPIREAD
	MODULE PROCEDURE MPIREAD_STR,MPIREAD_INT,MPIREAD_INTARR,MPIREAD_REAL,MPIREAD_REALARR &
	,MPIREAD_DBLE,MPIREAD_DBLEARR,MPIREAD_CMPLX,MPIREAD_CMPLXARR,MPIREAD_LOGICAL,MPIREAD_LOGICALARR
END INTERFACE
!!MPIREAD(ANTYPE msg)

INTERFACE MPIWRITE
	MODULE PROCEDURE MPIWRITE_STR,MPIWRITE_INT,MPIWRITE_INTARR,MPIWRITE_REAL,MPIWRITE_REALARR &
	,MPIWRITE_DBLE,MPIWRITE_DBLEARR,MPIWRITE_CMPLX,MPIWRITE_CMPLXARR,MPIWRITE_LOGICAL,MPIWRITE_LOGICALARR
END INTERFACE
!!MPIWRITE(ANYTYPE msg, OPTIONAL FMT)

CONTAINS
!!%%%%%%%%%%%%%%%%%%%%%%%% MPISTART,MPIEND,MPIRANK,MPINUMNODES %%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE MPISTART()
#IFDEF MPI
	INTEGER IERROR
	CALL MPI_INIT(ierror)
	IF(IERROR.NE.MPI_SUCCESS) PAUSE "MPI Error: can not start MPI."
#ENDIF
END SUBROUTINE

SUBROUTINE MPIEND()
#IFDEF MPI
	INTEGER IERROR
	CALL MPI_FINALIZE(ierror)
	IF(IERROR.NE.MPI_SUCCESS) PAUSE "MPI Error: can not stop MPI."
#ENDIF
END SUBROUTINE

FUNCTION MPIRANK()
INTEGER::MPIRANK
#IFDEF MPI
	INTEGER IERROR
	INTEGER,SAVE::RANK=-1
	IF(RANK.LT.0)THEN
		CALL MPI_COMM_RANK(MPI_COMM_WORLD,RANK,IERROR)
		IF(IERROR.NE.MPI_SUCCESS) PAUSE "MPI Error: can not read rank number."
	ENDIF
	MPIRANK=RANK
#ELSE
	MPIRANK=0
#ENDIF
END FUNCTION

FUNCTION MPINUMNODES()
INTEGER MPINUMNODES
#IFDEF MPI
	INTEGER IERROR
	INTEGER,SAVE::N=0
	IF(N.LE.0)THEN
		CALL MPI_COMM_SIZE(MPI_COMM_WORLD,N,IERROR)
		IF(IERROR.NE.MPI_SUCCESS) PAUSE "MPI Error: can not read number of nodes."
	ENDIF
	MPINUMNODES=N
#ELSE
	MPINUMNODES=1
#ENDIF
END FUNCTION
!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!!%%%%%%%%%%%%%%%%%%%%%%%% MPISEND %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE MPISEND_STR(DEST,TAG,MSG,LENGTH)
INTEGER DEST,TAG
INTEGER,OPTIONAL::LENGTH
CHARACTER(LEN=*)MSG
#IFDEF MPI
	INTEGER IERROR
	IF(PRESENT(LENGTH))THEN
		CALL MPI_SEND(MSG,LENGTH,MPI_CHARACTER,DEST,TAG,MPI_COMM_WORLD,IERROR)
	ELSE
		CALL MPI_SEND(MSG,LEN_TRIM(MSG),MPI_CHARACTER,DEST,TAG,MPI_COMM_WORLD,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not send the following message to node",DEST
		WRITE(*,*) "===",TRIM(MSG),"==="
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPISEND_INT(DEST,TAG,NUM)
INTEGER DEST,TAG,NUM
#IFDEF MPI
	INTEGER IERROR
	CALL MPI_SEND(NUM,1,MPI_INTEGER,DEST,TAG,MPI_COMM_WORLD,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not send the following integer to node",DEST
		WRITE(*,*) "===",NUM,"  ==="
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPISEND_INTARR(DEST,TAG,NUM)
INTEGER DEST,TAG
INTEGER,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR
	CALL MPI_SEND(NUM,SIZE(NUM),MPI_INTEGER,DEST,TAG,MPI_COMM_WORLD,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not send integer array to node",DEST
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPISEND_REAL(DEST,TAG,NUM)
INTEGER DEST,TAG
REAL NUM
#IFDEF MPI
	INTEGER IERROR
	CALL MPI_SEND(NUM,1,MPI_REAL,DEST,TAG,MPI_COMM_WORLD,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not send the following number to node",DEST
		WRITE(*,*) "===",NUM,"  ==="
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPISEND_REALARR(DEST,TAG,NUM)
INTEGER DEST,TAG
REAL,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR
	CALL MPI_SEND(NUM,SIZE(NUM),MPI_REAL,DEST,TAG,MPI_COMM_WORLD,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not send real array to node",DEST
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPISEND_DBLE(DEST,TAG,NUM)
INTEGER DEST,TAG
DOUBLEPRECISION NUM
#IFDEF MPI
	INTEGER IERROR
	CALL MPI_SEND(NUM,1,MPI_DOUBLE_PRECISION,DEST,TAG,MPI_COMM_WORLD,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not send the following number to node",DEST
		WRITE(*,*) "===",NUM,"  ==="
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPISEND_DBLEARR(DEST,TAG,NUM)
INTEGER DEST,TAG
DOUBLEPRECISION,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR
	CALL MPI_SEND(NUM,SIZE(NUM),MPI_DOUBLE_PRECISION,DEST,TAG,MPI_COMM_WORLD,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not send double precision array to node",DEST
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPISEND_CMPLX(DEST,TAG,NUM)
INTEGER DEST,TAG
COMPLEX NUM
#IFDEF MPI
	INTEGER IERROR
	CALL MPI_SEND(NUM,1,MPI_COMPLEX,DEST,TAG,MPI_COMM_WORLD,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not send the following number to node",DEST
		WRITE(*,*) "===",NUM,"  ==="
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPISEND_CMPLXARR(DEST,TAG,NUM)
INTEGER DEST,TAG
COMPLEX,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR
	CALL MPI_SEND(NUM,SIZE(NUM),MPI_COMPLEX,DEST,TAG,MPI_COMM_WORLD,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not send complex array to node",DEST
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPISEND_LOGICAL(DEST,TAG,TF)
INTEGER DEST,TAG
LOGICAL TF
#IFDEF MPI
	INTEGER IERROR
	CALL MPI_SEND(TF,1,MPI_LOGICAL,DEST,TAG,MPI_COMM_WORLD,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not send the following logical variable to node",DEST
		WRITE(*,*) "===",TF,"  ==="
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPISEND_LOGICALARR(DEST,TAG,TF)
INTEGER DEST,TAG
LOGICAL,DIMENSION(:),INTENT(IN)::TF
#IFDEF MPI
	INTEGER IERROR
	CALL MPI_SEND(TF,SIZE(TF),MPI_LOGICAL,DEST,TAG,MPI_COMM_WORLD,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not send logical array to node",DEST
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE
!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!!%%%%%%%%%%%%%%%%%%%%%%% MPIRECV %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE MPIRECV_STR(SOURCE,TAG,MSG,LENGTH)
INTEGER SOURCE,TAG
INTEGER,OPTIONAL::LENGTH
CHARACTER(LEN=*)MSG
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	IF(PRESENT(LENGTH))THEN
		CALL MPI_RECV(MSG,LENGTH,MPI_CHARACTER,SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	ELSE
		CALL MPI_RECV(MSG,LEN(MSG),MPI_CHARACTER,SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve message from node",SOURCE
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECV_INT(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
INTEGER NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_INTEGER,SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve integer from node",SOURCE
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECV_INTARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
INTEGER,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_INTEGER,SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve integer array from node",SOURCE
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECV_REAL(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
REAL NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_REAL,SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve real from node",SOURCE
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECV_REALARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
REAL,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_REAL,SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve real array from node",SOURCE
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECV_DBLE(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
DOUBLEPRECISION NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_DOUBLE_PRECISION,SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve doubleprecision from node",SOURCE
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECV_DBLEARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
DOUBLEPRECISION,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_DOUBLE_PRECISION,SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve doubleprecision array from node",SOURCE
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECV_CMPLX(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
COMPLEX NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_COMPLEX,SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex from node",SOURCE
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECV_CMPLXARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
COMPLEX,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_COMPLEX,SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex array from node",SOURCE
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECV_LOGICAL(SOURCE,TAG,TF)
INTEGER SOURCE,TAG
LOGICAL TF
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(TF,1,MPI_LOGICAL,SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex from node",SOURCE
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECV_LOGICALARR(SOURCE,TAG,TF)
INTEGER SOURCE,TAG
LOGICAL,DIMENSION(:),INTENT(IN)::TF
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(TF,SIZE(TF),MPI_LOGICAL,SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex array from node",SOURCE
		PAUSE
	ENDIF
#ENDIF
END SUBROUTINE
!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!!%%%%%%%%%%%%%%%%%%%%% MPIRECVANYSOURCE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE MPIRECVANYSOURCE_STR(SOURCE,TAG,MSG,LENGTH)
INTEGER SOURCE,TAG
INTEGER,OPTIONAL::LENGTH
CHARACTER(LEN=*)MSG
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	IF(PRESENT(LENGTH))THEN
		CALL MPI_RECV(MSG,LENGTH,MPI_CHARACTER,MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	ELSE
		CALL MPI_RECV(MSG,LEN(MSG),MPI_CHARACTER,MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve message from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYSOURCE_INT(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
INTEGER NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_INTEGER,MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve integer from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYSOURCE_INTARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
INTEGER,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_INTEGER,MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve integer array from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYSOURCE_REAL(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
REAL NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_REAL,MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve real from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYSOURCE_REALARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
REAL,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_REAL,MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve real array from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYSOURCE_DBLE(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
DOUBLEPRECISION NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_DOUBLE_PRECISION,MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve doubleprecision from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYSOURCE_DBLEARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
DOUBLEPRECISION,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_DOUBLE_PRECISION,MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve doubleprecision array from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYSOURCE_CMPLX(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
COMPLEX NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_COMPLEX,MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYSOURCE_CMPLXARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
COMPLEX,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_COMPLEX,MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex array from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYSOURCE_LOGICAL(SOURCE,TAG,TF)
INTEGER SOURCE,TAG
LOGICAL TF
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(TF,1,MPI_LOGICAL,MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYSOURCE_LOGICALARR(SOURCE,TAG,TF)
INTEGER SOURCE,TAG
LOGICAL,DIMENSION(:),INTENT(IN)::TF
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(TF,SIZE(TF),MPI_LOGICAL,MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex array from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
	ENDIF
#ENDIF
END SUBROUTINE
!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


!!%%%%%%%%%%%%%%%%%%%%% MPIRECVANYTAG %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE MPIRECVANYTAG_STR(SOURCE,TAG,MSG,LENGTH)
INTEGER SOURCE,TAG
INTEGER,OPTIONAL::LENGTH
CHARACTER(LEN=*)MSG
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	IF(PRESENT(LENGTH))THEN
		CALL MPI_RECV(MSG,LENGTH,MPI_CHARACTER,SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	ELSE
		CALL MPI_RECV(MSG,LEN(MSG),MPI_CHARACTER,SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve message from node",SOURCE
		PAUSE
	ELSE
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYTAG_INT(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
INTEGER NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_INTEGER,SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve integer from node",SOURCE
		PAUSE
	ELSE
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYTAG_INTARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
INTEGER,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_INTEGER,SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve integer array from node",SOURCE
		PAUSE
	ELSE
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYTAG_REAL(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
REAL NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_REAL,SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve real from node",SOURCE
		PAUSE
	ELSE
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYTAG_REALARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
REAL,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_REAL,SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve real array from node",SOURCE
		PAUSE
	ELSE
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYTAG_DBLE(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
DOUBLEPRECISION NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_DOUBLE_PRECISION,SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve doubleprecision from node",SOURCE
		PAUSE
	ELSE
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYTAG_DBLEARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
DOUBLEPRECISION,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_DOUBLE_PRECISION,SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve doubleprecision array from node",SOURCE
		PAUSE
	ELSE
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYTAG_CMPLX(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
COMPLEX NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_COMPLEX,SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex from node",SOURCE
		PAUSE
	ELSE
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYTAG_CMPLXARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
COMPLEX,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_COMPLEX,SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex array from node",SOURCE
		PAUSE
	ELSE
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYTAG_LOGICAL(SOURCE,TAG,TF)
INTEGER SOURCE,TAG
LOGICAL TF
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(TF,1,MPI_LOGICAL,SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex from node",SOURCE
		PAUSE
	ELSE
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANYTAG_LOGICALARR(SOURCE,TAG,TF)
INTEGER SOURCE,TAG
LOGICAL,DIMENSION(:),INTENT(IN)::TF
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(TF,SIZE(TF),MPI_LOGICAL,SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex array from node",SOURCE
		PAUSE
	ELSE
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE
!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!!%%%%%%%%%%%%%%%%%%%%% MPIRECVANY %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE MPIRECVANY_STR(SOURCE,TAG,MSG,LENGTH)
INTEGER SOURCE,TAG
INTEGER,OPTIONAL::LENGTH
CHARACTER(LEN=*)MSG
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	IF(PRESENT(LENGTH))THEN
		CALL MPI_RECV(MSG,LENGTH,MPI_CHARACTER,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	ELSE
		CALL MPI_RECV(MSG,LEN(MSG),MPI_CHARACTER,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve message from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANY_INT(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
INTEGER NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_INTEGER,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve integer from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANY_INTARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
INTEGER,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_INTEGER,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve integer array from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANY_REAL(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
REAL NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_REAL,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve real from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANY_REALARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
REAL,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_REAL,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve real array from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANY_DBLE(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
DOUBLEPRECISION NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_DOUBLE_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve doubleprecision from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANY_DBLEARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
DOUBLEPRECISION,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_DOUBLE_PRECISION,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve doubleprecision array from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANY_CMPLX(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
COMPLEX NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,1,MPI_COMPLEX,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANY_CMPLXARR(SOURCE,TAG,NUM)
INTEGER SOURCE,TAG
COMPLEX,DIMENSION(:),INTENT(IN)::NUM
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(NUM,SIZE(NUM),MPI_COMPLEX,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex array from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANY_LOGICAL(SOURCE,TAG,TF)
INTEGER SOURCE,TAG
LOGICAL TF
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(TF,1,MPI_LOGICAL,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE

SUBROUTINE MPIRECVANY_LOGICALARR(SOURCE,TAG,TF)
INTEGER SOURCE,TAG
LOGICAL,DIMENSION(:),INTENT(IN)::TF
#IFDEF MPI
	INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
	CALL MPI_RECV(TF,SIZE(TF),MPI_LOGICAL,MPI_ANY_SOURCE,MPI_ANY_TAG,MPI_COMM_WORLD,STATUS,IERROR)
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: can not recieve complex array from node",SOURCE
		PAUSE
	ELSE
		SOURCE=STATUS(1)
		TAG=STATUS(2)
	ENDIF
#ENDIF
END SUBROUTINE
!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MPIBCAST %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE MPIBCAST_STR(MSG,ROOT)
CHARACTER(LEN=*)MSG
INTEGER,OPTIONAL::ROOT
#IFDEF MPI
	INTEGER IERROR
	IF(PRESENT(ROOT))THEN
		CALL MPI_BCAST(MSG,LEN(MSG),MPI_CHARACTER,ROOT,MPI_COMM_WORLD,IERROR)
	ELSE
		CALL MPI_BCAST(MSG,LEN(MSG),MPI_CHARACTER,0,MPI_COMM_WORLD,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: broadcast failing"
		PAUSE
	ENDIF	
#ENDIF
END SUBROUTINE

SUBROUTINE MPIBCAST_INT(MSG,ROOT)
INTEGER MSG
INTEGER,OPTIONAL::ROOT
#IFDEF MPI
	INTEGER IERROR
	IF(PRESENT(ROOT))THEN
		CALL MPI_BCAST(MSG,1,MPI_INTEGER,ROOT,MPI_COMM_WORLD,IERROR)
	ELSE
		CALL MPI_BCAST(MSG,1,MPI_INTEGER,0,MPI_COMM_WORLD,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: broadcast failing"
		PAUSE
	ENDIF	
#ENDIF
END SUBROUTINE

SUBROUTINE MPIBCAST_REAL(MSG,ROOT)
REAL MSG
INTEGER,OPTIONAL::ROOT
#IFDEF MPI
	INTEGER IERROR
	IF(PRESENT(ROOT))THEN
		CALL MPI_BCAST(MSG,1,MPI_REAL,ROOT,MPI_COMM_WORLD,IERROR)
	ELSE
		CALL MPI_BCAST(MSG,1,MPI_REAL,0,MPI_COMM_WORLD,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: broadcast failing"
		PAUSE
	ENDIF	
#ENDIF
END SUBROUTINE

SUBROUTINE MPIBCAST_DBLE(MSG,ROOT)
DOUBLEPRECISION MSG
INTEGER,OPTIONAL::ROOT
#IFDEF MPI
	INTEGER IERROR
	IF(PRESENT(ROOT))THEN
		CALL MPI_BCAST(MSG,1,MPI_DOUBLE_PRECISION,ROOT,MPI_COMM_WORLD,IERROR)
	ELSE
		CALL MPI_BCAST(MSG,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: broadcast failing"
		PAUSE
	ENDIF	
#ENDIF
END SUBROUTINE

SUBROUTINE MPIBCAST_CMPLX(MSG,ROOT)
COMPLEX MSG
INTEGER,OPTIONAL::ROOT
#IFDEF MPI
	INTEGER IERROR
	IF(PRESENT(ROOT))THEN
		CALL MPI_BCAST(MSG,1,MPI_COMPLEX,ROOT,MPI_COMM_WORLD,IERROR)
	ELSE
		CALL MPI_BCAST(MSG,1,MPI_COMPLEX,0,MPI_COMM_WORLD,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: broadcast failing"
		PAUSE
	ENDIF	
#ENDIF
END SUBROUTINE

SUBROUTINE MPIBCAST_LOGICAL(MSG,ROOT)
LOGICAL MSG
INTEGER,OPTIONAL::ROOT
#IFDEF MPI
	INTEGER IERROR
	IF(PRESENT(ROOT))THEN
		CALL MPI_BCAST(MSG,1,MPI_LOGICAL,ROOT,MPI_COMM_WORLD,IERROR)
	ELSE
		CALL MPI_BCAST(MSG,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: broadcast failing"
		PAUSE
	ENDIF	
#ENDIF
END SUBROUTINE

SUBROUTINE MPIBCAST_INTARR(MSG,ROOT)
INTEGER,DIMENSION(:),INTENT(IN)::MSG
INTEGER,OPTIONAL::ROOT
#IFDEF MPI
	INTEGER IERROR
	IF(PRESENT(ROOT))THEN
		CALL MPI_BCAST(MSG,SIZE(MSG),MPI_INTEGER,ROOT,MPI_COMM_WORLD,IERROR)
	ELSE
		CALL MPI_BCAST(MSG,SIZE(MSG),MPI_INTEGER,0,MPI_COMM_WORLD,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: broadcast failing"
		PAUSE
	ENDIF	
#ENDIF
END SUBROUTINE

SUBROUTINE MPIBCAST_REALARR(MSG,ROOT)
REAL,DIMENSION(:),INTENT(IN)::MSG
INTEGER,OPTIONAL::ROOT
#IFDEF MPI
	INTEGER IERROR
	IF(PRESENT(ROOT))THEN
		CALL MPI_BCAST(MSG,SIZE(MSG),MPI_REAL,ROOT,MPI_COMM_WORLD,IERROR)
	ELSE
		CALL MPI_BCAST(MSG,SIZE(MSG),MPI_REAL,0,MPI_COMM_WORLD,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: broadcast failing"
		PAUSE
	ENDIF	
#ENDIF
END SUBROUTINE

SUBROUTINE MPIBCAST_DBLEARR(MSG,ROOT)
DOUBLEPRECISION,DIMENSION(:),INTENT(IN)::MSG
INTEGER,OPTIONAL::ROOT
#IFDEF MPI
	INTEGER IERROR
	IF(PRESENT(ROOT))THEN
		CALL MPI_BCAST(MSG,SIZE(MSG),MPI_DOUBLE_PRECISION,ROOT,MPI_COMM_WORLD,IERROR)
	ELSE
		CALL MPI_BCAST(MSG,SIZE(MSG),MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: broadcast failing"
		PAUSE
	ENDIF	
#ENDIF
END SUBROUTINE

SUBROUTINE MPIBCAST_CMPLXARR(MSG,ROOT)
COMPLEX,DIMENSION(:),INTENT(IN)::MSG
INTEGER,OPTIONAL::ROOT
#IFDEF MPI
	INTEGER IERROR
	IF(PRESENT(ROOT))THEN
		CALL MPI_BCAST(MSG,SIZE(MSG),MPI_COMPLEX,ROOT,MPI_COMM_WORLD,IERROR)
	ELSE
		CALL MPI_BCAST(MSG,SIZE(MSG),MPI_COMPLEX,0,MPI_COMM_WORLD,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: broadcast failing"
		PAUSE
	ENDIF	
#ENDIF
END SUBROUTINE

SUBROUTINE MPIBCAST_LOGICALARR(MSG,ROOT)
LOGICAL,DIMENSION(:),INTENT(IN)::MSG
INTEGER,OPTIONAL::ROOT
#IFDEF MPI
	INTEGER IERROR
	IF(PRESENT(ROOT))THEN
		CALL MPI_BCAST(MSG,SIZE(MSG),MPI_LOGICAL,ROOT,MPI_COMM_WORLD,IERROR)
	ELSE
		CALL MPI_BCAST(MSG,SIZE(MSG),MPI_LOGICAL,0,MPI_COMM_WORLD,IERROR)
	ENDIF
	IF(IERROR.NE.MPI_SUCCESS)THEN
		WRITE(*,*) "MPI ERROR: broadcast failing"
		PAUSE
	ENDIF	
#ENDIF
END SUBROUTINE
!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!!%%%%%%%%%%%%%%%%%%%%%%% MPIREAD %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE MPIREAD_STR(MSG)
CHARACTER(LEN=*)MSG
#IFDEF MPI
	IF(MPIRANK().EQ.0)THEN
		READ(*,*)MSG
	ENDIF
	CALL MPIBCAST(MSG)
#ELSE
	READ(*,*)MSG
#ENDIF
END SUBROUTINE

SUBROUTINE MPIREAD_INT(MSG)
INTEGER MSG
#IFDEF MPI
	IF(MPIRANK().EQ.0)THEN
		READ(*,*)MSG
	ENDIF
	CALL MPIBCAST(MSG)
#ELSE
	READ(*,*)MSG
#ENDIF
END SUBROUTINE

SUBROUTINE MPIREAD_REAL(MSG)
REAL MSG
#IFDEF MPI
	IF(MPIRANK().EQ.0)THEN
		READ(*,*)MSG
	ENDIF
	CALL MPIBCAST(MSG)
#ELSE
	READ(*,*)MSG
#ENDIF
END SUBROUTINE

SUBROUTINE MPIREAD_DBLE(MSG)
DOUBLEPRECISION MSG
#IFDEF MPI
	IF(MPIRANK().EQ.0)THEN
		READ(*,*)MSG
	ENDIF
	CALL MPIBCAST(MSG)
#ELSE
	READ(*,*)MSG
#ENDIF
END SUBROUTINE

SUBROUTINE MPIREAD_CMPLX(MSG)
COMPLEX MSG
#IFDEF MPI
	IF(MPIRANK().EQ.0)THEN
		READ(*,*)MSG
	ENDIF
	CALL MPIBCAST(MSG)
#ELSE
	READ(*,*)MSG
#ENDIF
END SUBROUTINE

SUBROUTINE MPIREAD_LOGICAL(MSG)
LOGICAL MSG
#IFDEF MPI
	IF(MPIRANK().EQ.0)THEN
		READ(*,*)MSG
	ENDIF
	CALL MPIBCAST(MSG)
#ELSE
	READ(*,*)MSG
#ENDIF
END SUBROUTINE

SUBROUTINE MPIREAD_INTARR(MSG)
INTEGER,DIMENSION(:),INTENT(OUT)::MSG
#IFDEF MPI
	IF(MPIRANK().EQ.0)THEN
		READ(*,*)MSG
	ENDIF
	CALL MPIBCAST(MSG(1:SIZE(MSG)))
#ELSE
	READ(*,*)MSG
#ENDIF
END SUBROUTINE

SUBROUTINE MPIREAD_REALARR(MSG)
REAL,DIMENSION(:),INTENT(OUT)::MSG
#IFDEF MPI
	IF(MPIRANK().EQ.0)THEN
		READ(*,*)MSG
	ENDIF
	CALL MPIBCAST(MSG(1:SIZE(MSG)))
#ELSE
	READ(*,*)MSG
#ENDIF
END SUBROUTINE

SUBROUTINE MPIREAD_DBLEARR(MSG)
DOUBLEPRECISION,DIMENSION(:),INTENT(OUT)::MSG
#IFDEF MPI
	IF(MPIRANK().EQ.0)THEN
		READ(*,*)MSG
	ENDIF
	CALL MPIBCAST(MSG(1:SIZE(MSG)))
#ELSE
	READ(*,*)MSG
#ENDIF
END SUBROUTINE

SUBROUTINE MPIREAD_CMPLXARR(MSG)
COMPLEX,DIMENSION(:),INTENT(OUT)::MSG
#IFDEF MPI
	IF(MPIRANK().EQ.0)THEN
		READ(*,*)MSG
	ENDIF
	CALL MPIBCAST(MSG(1:SIZE(MSG)))
#ELSE
	READ(*,*)MSG
#ENDIF
END SUBROUTINE

SUBROUTINE MPIREAD_LOGICALARR(MSG)
LOGICAL,DIMENSION(:),INTENT(OUT)::MSG
#IFDEF MPI
	IF(MPIRANK().EQ.0)THEN
		READ(*,*)MSG
	ENDIF
	CALL MPIBCAST(MSG(1:SIZE(MSG)))
#ELSE
	READ(*,*)MSG
#ENDIF
END SUBROUTINE
!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MPIWRITE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE MPIWRITE_STR(MSG,FMT)
CHARACTER(LEN=*)MSG
CHARACTER(LEN=*),OPTIONAL::FMT
IF(MPIRANK().EQ.0)THEN
	IF(PRESENT(FMT))THEN
		WRITE(*,FMT)MSG
	ELSE
		PRINT*,MSG
	ENDIF
ENDIF
END SUBROUTINE

SUBROUTINE MPIWRITE_INT(MSG,FMT)
INTEGER MSG
CHARACTER(LEN=*),OPTIONAL::FMT
IF(MPIRANK().EQ.0)THEN
	IF(PRESENT(FMT))THEN
		WRITE(*,FMT)MSG
	ELSE
		PRINT*,MSG
	ENDIF
ENDIF
END SUBROUTINE

SUBROUTINE MPIWRITE_REAL(MSG,FMT)
REAL MSG
CHARACTER(LEN=*),OPTIONAL::FMT
IF(MPIRANK().EQ.0)THEN
	IF(PRESENT(FMT))THEN
		WRITE(*,FMT)MSG
	ELSE
		PRINT*,MSG
	ENDIF
ENDIF
END SUBROUTINE

SUBROUTINE MPIWRITE_DBLE(MSG,FMT)
DOUBLEPRECISION MSG
CHARACTER(LEN=*),OPTIONAL::FMT
IF(MPIRANK().EQ.0)THEN
	IF(PRESENT(FMT))THEN
		WRITE(*,FMT)MSG
	ELSE
		PRINT*,MSG
	ENDIF
ENDIF
END SUBROUTINE

SUBROUTINE MPIWRITE_CMPLX(MSG,FMT)
COMPLEX MSG
CHARACTER(LEN=*),OPTIONAL::FMT
IF(MPIRANK().EQ.0)THEN
	IF(PRESENT(FMT))THEN
		WRITE(*,FMT)MSG
	ELSE
		PRINT*,MSG
	ENDIF
ENDIF
END SUBROUTINE

SUBROUTINE MPIWRITE_LOGICAL(MSG,FMT)
LOGICAL MSG
CHARACTER(LEN=*),OPTIONAL::FMT
IF(MPIRANK().EQ.0)THEN
	IF(PRESENT(FMT))THEN
		WRITE(*,FMT)MSG
	ELSE
		PRINT*,MSG
	ENDIF
ENDIF
END SUBROUTINE

SUBROUTINE MPIWRITE_INTARR(MSG,FMT)
INTEGER,DIMENSION(:),INTENT(IN)::MSG
CHARACTER(LEN=*),OPTIONAL::FMT
IF(MPIRANK().EQ.0)THEN
	IF(PRESENT(FMT))THEN
		WRITE(*,FMT)MSG
	ELSE
		PRINT*,MSG
	ENDIF
ENDIF
END SUBROUTINE

SUBROUTINE MPIWRITE_REALARR(MSG,FMT)
REAL,DIMENSION(:),INTENT(IN)::MSG
CHARACTER(LEN=*),OPTIONAL::FMT
IF(MPIRANK().EQ.0)THEN
	IF(PRESENT(FMT))THEN
		WRITE(*,FMT)MSG
	ELSE
		PRINT*,MSG
	ENDIF
ENDIF
END SUBROUTINE

SUBROUTINE MPIWRITE_DBLEARR(MSG,FMT)
DOUBLEPRECISION,DIMENSION(:),INTENT(IN)::MSG
CHARACTER(LEN=*),OPTIONAL::FMT
IF(MPIRANK().EQ.0)THEN
	IF(PRESENT(FMT))THEN
		WRITE(*,FMT)MSG
	ELSE
		PRINT*,MSG
	ENDIF
ENDIF
END SUBROUTINE

SUBROUTINE MPIWRITE_CMPLXARR(MSG,FMT)
COMPLEX,DIMENSION(:),INTENT(IN)::MSG
CHARACTER(LEN=*),OPTIONAL::FMT
IF(MPIRANK().EQ.0)THEN
	IF(PRESENT(FMT))THEN
		WRITE(*,FMT)MSG
	ELSE
		PRINT*,MSG
	ENDIF
ENDIF
END SUBROUTINE

SUBROUTINE MPIWRITE_LOGICALARR(MSG,FMT)
LOGICAL,DIMENSION(:),INTENT(IN)::MSG
CHARACTER(LEN=*),OPTIONAL::FMT
IF(MPIRANK().EQ.0)THEN
	IF(PRESENT(FMT))THEN
		WRITE(*,FMT)MSG
	ELSE
		PRINT*,MSG
	ENDIF
ENDIF
END SUBROUTINE
!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

END MODULE