SUBROUTINE mp_bcast_am(msg, source, gid)
CHARACTER(LEN=*) :: msg(:)
INTEGER :: source
TYPE(mp_comm_type), INTENT(IN) :: gid
CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_bcast_am'
INTEGER :: handle, ierr
#if defined(__parallel)
INTEGER :: i, j, k, msglen, msgsiz, &
numtask, taskid
INTEGER, ALLOCATABLE :: imsg(:), imsglen(:)
#endif
ierr = 0
CALL timeset(routineN, handle)
#if defined(__parallel)
CALL mp_environ(numtask, taskid, gid)
msgsiz = SIZE(msg)
! Determine size of the minimum array of integers to broadcast the string
ALLOCATE (imsglen(1:msgsiz))
DO j = 1, msgsiz
IF (taskid == source) imsglen(j) = LEN_TRIM(msg(j))
END DO
CALL mp_bcast(imsglen, source, gid)
msglen = SUM(imsglen)
! this is a workaround to avoid problems on the T3E
! at the moment we have a data alignment error when trying to
! broadcast characters on the T3E (not always!)
! JH 19/3/99 on galileo
! CALL mpi_bcast(msg,msglen,MPI_CHARACTER,source,gid,ierr)
ALLOCATE (imsg(1:msglen))
k = 0
DO j = 1, msgsiz
DO i = 1, imsglen(j)
k = k + 1
imsg(k) = ICHAR(msg(j) (i:i))
END DO
END DO
CALL mpi_bcast(imsg, msglen, MPI_INTEGER, source, gid%handle, ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_bcast @ "//routineN)
msg = ""
k = 0
DO j = 1, msgsiz
DO i = 1, imsglen(j)
k = k + 1
msg(j) (i:i) = CHAR(imsg(k))
END DO
END DO
DEALLOCATE (imsg)
DEALLOCATE (imsglen)
CALL add_perf(perf_id=2, msg_size=msglen*charlen*msgsiz)
#else
MARK_USED(msg)
MARK_USED(source)
MARK_USED(gid)
#endif
CALL timestop(handle)
END SUBROUTINE mp_bcast_am