#if defined(MPI)
*DECK SNDMPI
      SUBROUTINE SNDMPI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
* EXPORT THE CONTENT OF A LCM OBJECT USING MPI
*
* INPUT/OUTPUT PARAMETERS:
*  NENTRY : NUMBER OF LCM OBJECTS AND FILES USED BY THE MODULE.
*  HENTRY : CHARACTER*12 NAME OF EACH LCM OBJECT.
*  IENTRY : =0 CLE-2000 VARIABLE; =1 LINKED LIST; =2 XSM FILE;
*           =3 SEQUENTIAL BINARY FILE; =4 SEQUENTIAL ASCII FILE;
*           =5 DIRECT ACCESS FILE.
*  JENTRY : =0 THE LINKED LIST OR FILE IS CREATED.
*           =1 THE LINKED LIST OR FILE IS OPEN FOR MODIFICATIONS;
*           =2 THE LINKED LIST OR FILE IS OPEN IN READ-ONLY MODE.
*  KENTRY : =FILE UNIT NUMBER; =LCM OBJECT ADDRESS OTHERWISE.
*           DIMENSION HENTRY(NENTRY),IENTRY(NENTRY),JENTRY(NENTRY),
*           KENTRY(NENTRY)
*
* LCM OBJECTS:
*  HENTRY(1) : ANY CREATE LCM OBJECT
*  HENTRY(2) : ANY READ-ONLY LCM OBJECT
*
*----------------------------------- AUTHOR: R. CHAMBON ; 01/05/2003 ---
*
      USE GANLIB
      include 'mpif.h'
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      CHARACTER HENTRY(NENTRY)*12
      TYPE(C_PTR) KENTRY(NENTRY)
*----
*  LOCAL VARIABLES
*----
      PARAMETER (MAXLEV=50)
      PARAMETER (IHEAD=0,IHNAM=1,ILLIST=4,INEXT=5,IFATH=6,IFDIR=7,
     1 IMODE=8,INREF=10,LFNODE=12)
      PARAMETER (JDATA=0,JJLON=1,JJTYP=2,JCMT=7)
      PARAMETER (IPRT=1)
      TYPE(C_PTR) IPLIS1,IPLIS2
      CHARACTER NAMT*12,HSMG*131,NAMLCM*12,MYNAME*12,PATH(MAXLEV)*12,
     1 FIRST(MAXLEV)*12
      LOGICAL EMPTY,LCM
      TYPE(C_PTR) KDATA1(MAXLEV),KDATA2(MAXLEV)
      INTEGER KJLON(MAXLEV),IVEC(MAXLEV),IGO(MAXLEV)
      INTEGER*4 IPRINT,RANK,SIZE,IERR,ICOMM,ITAG
      INTEGER*4 ICPUFM,ICPUTO
      LOGICAL   LALL,LCPUFM,LCPUTO,LITEM
      INTEGER   ILONG,ITYLCM
      CHARACTER TEXT12*12
      CHARACTER HMSG*131
      DOUBLE PRECISION DFLOTT,DFLOTTT,DFLOTTF
*----
*  ALLOCATABLE STATEMENTS
*----
      INTEGER, ALLOCATABLE, DIMENSION(:) :: ISTATU,IASS

#if defined(__x86_64__)
#  define M64 2
#else
#  define M64 1
#endif

*----
*  VALIDITY OF OBJECTS
*----
      IF( NENTRY.EQ.2 )THEN
*     CALL XABORT('SENDP: 2 OBJECTS EXPECTED.')
*     CHECK LL# 1 = ANY OBJECT (LINKED_LIST OR XSM_FILE) IS READ ONLY
      IF((JENTRY(2).NE.2).OR.((IENTRY(2).NE.1).AND.(IENTRY(2).NE.2)))
     1 CALL XABORT('SNDMPI: LINKED LIST OR XSM FILE IN READ-ONLY'
     2 //' MODE EXPECTED AT RHS:'//HENTRY(2))
      IPLIS1= KENTRY(2)
*     CHECK LL# 2 = ANY OBJECT (LINKED_LIST OR XSM_FILE) IS CREATED
      IF((JENTRY(1).NE.0).OR.((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)))
     1 CALL XABORT('SNDMPI: LINKED LIST OR XSM FILE IN CREATED'
     2 //' MODE EXPECTED AT LHS:'//HENTRY(1))
      IPLIS2= KENTRY(1)
      ENDIF
*----
*  VARIABLE INITIALISATION        
*----
      IPRINT=  0
      ICPUFM= -1
      ICPUTO= -1
      ICOMM= MPI_COMM_WORLD
      ALLOCATE(ISTATU(MPI_STATUS_SIZE))
      ITAG=1
      LALL=.FALSE.
      LITEM=.FALSE.
      CALL MPI_COMM_RANK(ICOMM,RANK,IERR)
      CALL MPI_COMM_SIZE(ICOMM,SIZE,IERR)
      CALL MPI_TYPE_CONTIGUOUS(12,MPI_CHARACTER,MPI_DIRNAME,IERR)
      CALL MPI_TYPE_COMMIT(MPI_DIRNAME,IERR)
      CALL MPI_TYPE_CONTIGUOUS(4,MPI_CHARACTER,MPI_CHAR4,IERR)
      CALL MPI_TYPE_COMMIT(MPI_CHAR4,IERR)
      LCPUFM=.FALSE.
      LCPUTO=.FALSE.
*----
*  READ USER INPUT:
*----
    2 CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
* EDITION LEVEL      
      IF(TEXT12.EQ.'EDIT') THEN
         CALL REDGET(ITYP,IPRINT,FLOTT,TEXT12,DFLOTT)
         IF(ITYP.NE.1) CALL XABORT('SNDMPI: *IPRINT* MUST BE INTEGER')
* CPU FROM
      ELSEIF(TEXT12.EQ.'FROM')THEN
         CALL REDGET(ITYP,ICPUFM,FLOTT,TEXT12,DFLOTT)
         IF(ITYP.NE.1) CALL XABORT('SNDMPI: *ICPUFM* MUST BE'
     1      //'INTEGER AFTER FROM')
         IF((ICPUFM.LT.0).OR.(ICPUFM.GE.SIZE)) THEN
           WRITE(HMSG,2000) ICPUFM,SIZE-1
           CALL XABORT(HMSG)
         ENDIF
         LCPUFM=(ICPUFM.EQ.RANK)
* CPU TO
      ELSEIF(TEXT12.EQ.'TO')THEN
         CALL REDGET(ITYP,ICPUTO,FLOTT,TEXT12,DFLOTT)
         IF((ITYP.NE.1).AND.(TEXT12.NE.'ALL')) CALL XABORT('SNDMPI:'
     1      //'*ICPUTO* MUST BE INTEGER OR THE KEYWORD: ALL')
         IF(((ICPUTO.LT.0).OR.(ICPUTO.GE.SIZE)).AND.(TEXT12.NE.'ALL'))
     1   THEN
           WRITE(HMSG,2010) ICPUTO,SIZE-1
           CALL XABORT(HMSG)
         ENDIF
         IF(TEXT12.EQ.'ALL')THEN
           LALL=.TRUE.
         ELSE
           LCPUTO=(ICPUTO.EQ.RANK)
         ENDIF
* ITEM
      ELSEIF(TEXT12.EQ.'ITEM')THEN
         LITEM=.TRUE.
         CALL REDGET(ITYPF,NITMAF,FLOTTF,TEXT12,DFLOTTF)
         CALL REDGET(ITYPT,NITMAT,FLOTTT,TEXT12,DFLOTTT)
         IF((ITYPF.NE.1.AND.ITYPF.NE.2.AND.ITYPF.NE.4.AND.ITYPF.NE.5)
     1      .OR.(ITYPF.NE.-ITYPT))THEN
         CALL XABORT('SNDMPI: INVALID TYPE FOR ITEM "FROM" OR "TO"')
         ENDIF
* END OF THIS SUBROUTINE
      ELSEIF( TEXT12.EQ.';' )THEN
         IF((ICPUFM.LT.0).OR.(ICPUTO.LT.0)) CALL XABORT('SNDMPI: '
     1      //'*FROM* OR *TO* KEYWORD IS MISSING')
         IF(LITEM.AND.(LALL.OR.LCPUFM.OR.LCPUTO)) GOTO 191
         ILEV=1
         KDATA1(1)=IPLIS1
         KDATA2(1)=IPLIS2
         KJLON(1)=-1
         IVEC(1)=1
         IGO(1)=5
         IF(LALL)THEN 
           GOTO 120
         ELSEIF(LCPUFM.OR.LCPUTO)THEN
           GOTO 20
         ELSE
           GOTO 200
         ENDIF
      ELSE
         CALL XABORT('SNDMPI: '//TEXT12//' IS AN INVALID KEYWORD.')
      ENDIF
      GO TO 2
*----
*  READING ON A CPU AND WRITING ON ANOTHER ONE
*----
*        USE A GENERAL COPY ALGORITHM.
*
*        ASSOCIATIVE TABLE.
   20    IF(LCPUFM) THEN
         CALL LCMINF(IPLIS1,NAMLCM,MYNAME,EMPTY,ILONG,LCM)
         CALL MPI_SEND(EMPTY,1*M64,MPI_LOGICAL,ICPUTO,
     1              ITAG,ICOMM,IERR)
         CALL MPI_SEND(ILONG,1*M64,MPI_INTEGER,ICPUTO,
     1              ITAG,ICOMM,IERR)
         ENDIF
         IF(LCPUTO) THEN
         CALL MPI_RECV(EMPTY,1*M64,MPI_LOGICAL,ICPUFM,
     1              ITAG,ICOMM,ISTATU,IERR)
         CALL MPI_RECV(ILONG,1*M64,MPI_INTEGER,ICPUFM,
     1              ITAG,ICOMM,ISTATU,IERR)
         ENDIF
         IF(EMPTY) GO TO ( 60, 60, 90, 90,200),IGO(ILEV)
         NAMT=' '
         IF(LCPUFM) THEN
         CALL LCMNXT(IPLIS1,NAMT)
         CALL MPI_SEND(NAMT,1,MPI_DIRNAME,ICPUTO,ITAG,ICOMM,IERR)
         ENDIF
         IF(LCPUTO) THEN
         CALL MPI_RECV(NAMT,1,MPI_DIRNAME,ICPUFM,
     1                 ITAG,ICOMM,ISTATU,IERR)
         ENDIF
*
         FIRST(ILEV)=NAMT
   30    IF(LCPUFM) THEN
         CALL LCMLEN(IPLIS1,NAMT,ILONG,ITYLCM)
         CALL MPI_SEND(ILONG,1*M64,MPI_INTEGER,ICPUTO,
     1              ITAG,ICOMM,IERR)
         CALL MPI_SEND(ITYLCM,1*M64,MPI_INTEGER,ICPUTO,
     1              ITAG,ICOMM,IERR)
         ENDIF
         IF(LCPUTO) THEN
         CALL MPI_RECV(ILONG,1*M64,MPI_INTEGER,ICPUFM,
     1                 ITAG,ICOMM,ISTATU,IERR)
         CALL MPI_RECV(ITYLCM,1*M64,MPI_INTEGER,ICPUFM,
     1                 ITAG,ICOMM,ISTATU,IERR)
         ENDIF
         IF((ILONG.NE.0).AND.(ITYLCM.EQ.0)) THEN
            IF(IPRT.GT.0) WRITE(6,1010) ILEV,NAMT,ITYLCM,ILONG
*           ASSOCIATIVE TABLE DATA.
            ILEV=ILEV+1
            IF(ILEV.GT.MAXLEV) THEN
               WRITE(HSMG,'(2A,A12,A)') 'LCMEQU: TOO MANY DIRECTORY ',
     1         'LEVELS ON ''',NAMLCM,'''(6).'
               CALL XABORT(HSMG)
            ENDIF
            KJLON(ILEV)=ILONG
            IF(LCPUFM) THEN
            KDATA1(ILEV)=LCMGID(IPLIS1,NAMT)
            ENDIF
            IF(LCPUTO) THEN
            KDATA2(ILEV)=LCMDID(IPLIS2,NAMT)
            ENDIF
            PATH(ILEV)=NAMT
            IF(LCPUFM) THEN
            IPLIS1=KDATA1(ILEV)
            ENDIF
            IF(LCPUTO) THEN
            IPLIS2=KDATA2(ILEV)
            ENDIF
            IVEC(ILEV)=1
            IGO(ILEV)=1
            GO TO  20
         ELSE IF((ILONG.NE.0).AND.(ITYLCM.EQ.10)) THEN
            IF(IPRT.GT.0) WRITE(6,1010) ILEV,NAMT,ITYLCM,ILONG
*           LIST DATA.
            ILEV=ILEV+1
            IF(ILEV.GT.MAXLEV) THEN
               WRITE(HSMG,'(2A,A12,A)') 'LCMEQU: TOO MANY DIRECTORY ',
     1         'LEVELS ON ''',NAMLCM,'''(7).'
               CALL XABORT(HSMG)
            ENDIF
            KJLON(ILEV)=ILONG
            IF(LCPUFM) THEN
            KDATA1(ILEV)=LCMGID(IPLIS1,NAMT)
            ENDIF
            IF(LCPUTO) THEN
            KDATA2(ILEV)=LCMLID(IPLIS2,NAMT,ILONG)
            ENDIF
            PATH(ILEV)=NAMT
            IF(LCPUFM) THEN
            IPLIS1=KDATA1(ILEV)
            ENDIF
            IF(LCPUTO) THEN
            IPLIS2=KDATA2(ILEV)
            ENDIF
            IVEC(ILEV)=0
            IGO(ILEV)=2
            GO TO  70
         ELSE IF((ILONG.NE.0).AND.(ITYLCM.LE.6)) THEN
            IF(IPRT.GT.0) WRITE(6,1010) ILEV,NAMT,ITYLCM,ILONG
*           DATA
            ALLOCATE(IASS(ILONG))
            IF(LCPUFM) THEN
               CALL LCMGET(IPLIS1,NAMT,IASS)
               CALL MPI_SEND(IASS,ILONG*M64,MPI_INTEGER,ICPUTO,
     1         ITAG,ICOMM,IERR)
            ENDIF
            IF(LCPUTO) THEN
               CALL MPI_RECV(IASS,ILONG*M64,MPI_INTEGER,ICPUFM,
     1         ITAG,ICOMM,ISTATU,IERR)
               CALL LCMPUT(IPLIS2,NAMT,ILONG,ITYLCM,IASS)
               DEALLOCATE(IASS)
            ENDIF
            IF(LCPUFM) DEALLOCATE(IASS)
         ENDIF
         IF(LCPUFM) THEN
         CALL LCMNXT(IPLIS1,NAMT)
         CALL MPI_SEND(NAMT,1,MPI_DIRNAME,ICPUTO,ITAG,ICOMM,IERR)
         ENDIF
         IF(LCPUTO) THEN
         CALL MPI_RECV(NAMT,1,MPI_DIRNAME,ICPUFM,ITAG,ICOMM,ISTATU,IERR)
         ENDIF
         IF(NAMT.NE.FIRST(ILEV)) GO TO  30
         GO TO ( 60, 60, 90, 90,200),IGO(ILEV)
*
   60    NAMT=PATH(ILEV)
         ILEV=ILEV-1
         IF(LCPUFM) THEN
         IPLIS1=KDATA1(ILEV)
         ENDIF
         IF(LCPUTO) THEN
         IPLIS2=KDATA2(ILEV)
         ENDIF
         IF(LCPUFM) THEN
         CALL LCMNXT(IPLIS1,NAMT)
         CALL MPI_SEND(NAMT,1,MPI_DIRNAME,ICPUTO,ITAG,ICOMM,IERR)
         ENDIF
         IF(LCPUTO) THEN
         CALL MPI_RECV(NAMT,1,MPI_DIRNAME,ICPUFM,ITAG,ICOMM,ISTATU,IERR)
         ENDIF
         IF(NAMT.NE.FIRST(ILEV)) GO TO  30
         GO TO ( 60, 60, 90, 90,200),IGO(ILEV)
*
*        LIST.
   70    IVEC(ILEV)=IVEC(ILEV)+1
         IF(IVEC(ILEV).GT.KJLON(ILEV)) THEN
            GO TO ( 60, 60, 90, 90,200),IGO(ILEV)
         ENDIF
         IF(LCPUFM) THEN
         CALL LCMLEL(KDATA1(ILEV),IVEC(ILEV),ILONG,ITYLCM)
         CALL MPI_SEND(ILONG,1*M64,MPI_INTEGER,ICPUTO,ITAG,ICOMM,IERR)
         CALL MPI_SEND(ITYLCM,1*M64,MPI_INTEGER,ICPUTO,ITAG,ICOMM,IERR)
         ENDIF
         IF(LCPUTO) THEN
         CALL MPI_RECV(ILONG,1*M64,MPI_INTEGER,ICPUFM,
     1                 ITAG,ICOMM,ISTATU,IERR)
         CALL MPI_RECV(ITYLCM,1*M64,MPI_INTEGER,ICPUFM,
     1                 ITAG,ICOMM,ISTATU,IERR)
         ENDIF
         IF((ILONG.NE.0).AND.(ITYLCM.EQ.0)) THEN
            IF(IPRT.GT.0) WRITE(6,1010) ILEV,NAMT,ITYLCM,ILONG
*           ASSOCIATIVE TABLE DATA.
            ILEV=ILEV+1
            IF(ILEV.GT.MAXLEV) THEN
               WRITE(HSMG,'(2A,A12,A)') 'LCMEQU: TOO MANY DIRECTORY ',
     1         'LEVELS ON ''',NAMLCM,'''(8).'
               CALL XABORT(HSMG)
            ENDIF
            KJLON(ILEV)=-1
            IF(LCPUFM) THEN
            KDATA1(ILEV)=LCMGIL(IPLIS1,IVEC(ILEV-1))
            ENDIF
            IF(LCPUTO) THEN
            KDATA2(ILEV)=LCMDIL(IPLIS2,IVEC(ILEV-1))
            ENDIF
            IF(LCPUFM) THEN
            IPLIS1=KDATA1(ILEV)
            ENDIF
            IF(LCPUTO) THEN
            IPLIS2=KDATA2(ILEV)
            ENDIF
            IVEC(ILEV)=1
            IGO(ILEV)=3
            GO TO  20
         ELSE IF((ILONG.NE.0).AND.(ITYLCM.EQ.10)) THEN
            IF(IPRT.GT.0) WRITE(6,1010) ILEV,NAMT,ITYLCM,ILONG
*           LIST DATA.
            ILEV=ILEV+1
            IF(ILEV.GT.MAXLEV) THEN
               WRITE(HSMG,'(2A,A12,A)') 'LCMEQU: TOO MANY DIRECTORY ',
     1         'LEVELS ON ''',NAMLCM,'''(9).'
               CALL XABORT(HSMG)
            ENDIF
            KJLON(ILEV)=ILONG
            IF(LCPUFM) THEN
            KDATA1(ILEV)=LCMGIL(IPLIS1,IVEC(ILEV-1))
            ENDIF
            IF(LCPUTO) THEN
            KDATA2(ILEV)=LCMLIL(IPLIS2,IVEC(ILEV-1),ILONG)
            ENDIF
            IF(LCPUFM) THEN
            IPLIS1=KDATA1(ILEV)
            ENDIF
            IF(LCPUTO) THEN
            IPLIS2=KDATA2(ILEV)
            ENDIF
            IVEC(ILEV)=0
            IGO(ILEV)=4
            GO TO  70
         ELSE IF((ILONG.NE.0).AND.(ITYLCM.LE.6)) THEN
            IF(IPRT.GT.0) WRITE(6,1010) ILEV,NAMT,ITYLCM,ILONG
*           DATA
            ALLOCATE(IASS(ILONG))
            IF(LCPUFM) THEN
               CALL LCMGDL(IPLIS1,IVEC(ILEV),IASS)
               CALL MPI_SEND(IASS,ILONG*M64,MPI_INTEGER,ICPUTO,
     1         ITAG,ICOMM,IERR)
            ENDIF
            IF(LCPUTO) THEN
               CALL MPI_RECV(IASS,ILONG*M64,MPI_INTEGER,ICPUFM,
     1         ITAG,ICOMM,ISTATU,IERR)
               CALL LCMPDL(IPLIS2,IVEC(ILEV),ILONG,ITYLCM,IASS)
               DEALLOCATE(IASS)
            ENDIF
            IF(LCPUFM) DEALLOCATE(IASS)
         ENDIF
         GO TO 70
*
   90    ILEV=ILEV-1
         IF(LCPUFM) THEN
         IPLIS1=KDATA1(ILEV)
         ENDIF
         IF(LCPUTO) THEN
         IPLIS2=KDATA2(ILEV)
         ENDIF
         GO TO  70
*----
*  READING ON A CPU AND WRITING ON ALL OTHER
*----
*        USE A GENERAL COPY ALGORITHM.
*
*        ASSOCIATIVE TABLE.
  120    IF(LCPUFM) THEN
         CALL LCMINF(IPLIS1,NAMLCM,MYNAME,EMPTY,ILONG,LCM)
         ENDIF
         CALL MPI_BCAST(EMPTY,1*M64,MPI_LOGICAL,ICPUFM,ICOMM,IERR)
         CALL MPI_BCAST(ILONG,1*M64,MPI_INTEGER,ICPUFM,ICOMM,IERR)
         IF(EMPTY) GO TO (160,160,190,190,200),IGO(ILEV)
         NAMT=' '
         IF(LCPUFM) THEN
         CALL LCMNXT(IPLIS1,NAMT)
         ENDIF
         CALL MPI_BCAST(NAMT,1,MPI_DIRNAME,ICPUFM,ICOMM,IERR)
*
         FIRST(ILEV)=NAMT
  130    IF(LCPUFM) THEN
         CALL LCMLEN(IPLIS1,NAMT,ILONG,ITYLCM)
         ENDIF
         CALL MPI_BCAST(ILONG,1*M64,MPI_INTEGER,ICPUFM,ICOMM,IERR)
         CALL MPI_BCAST(ITYLCM,1*M64,MPI_INTEGER,ICPUFM,ICOMM,IERR)
         IF((ILONG.NE.0).AND.(ITYLCM.EQ.0)) THEN
            IF(IPRT.GT.0) WRITE(6,1010) ILEV,NAMT,ITYLCM,ILONG
*           ASSOCIATIVE TABLE DATA.
            ILEV=ILEV+1
            IF(ILEV.GT.MAXLEV) THEN
               WRITE(HSMG,'(2A,A12,A)') 'LCMEQU: TOO MANY DIRECTORY ',
     1         'LEVELS ON ''',NAMLCM,'''(6).'
               CALL XABORT(HSMG)
            ENDIF
            KJLON(ILEV)=ILONG
            IF(LCPUFM) THEN
            KDATA1(ILEV)=LCMGID(IPLIS1,NAMT)
            ENDIF
            KDATA2(ILEV)=LCMDID(IPLIS2,NAMT)
            PATH(ILEV)=NAMT
            IF(LCPUFM) THEN
            IPLIS1=KDATA1(ILEV)
            ENDIF
            IPLIS2=KDATA2(ILEV)
            IVEC(ILEV)=1
            IGO(ILEV)=1
            GO TO 120
         ELSE IF((ILONG.NE.0).AND.(ITYLCM.EQ.10)) THEN
            IF(IPRT.GT.0) WRITE(6,1010) ILEV,NAMT,ITYLCM,ILONG
*           LIST DATA.
            ILEV=ILEV+1
            IF(ILEV.GT.MAXLEV) THEN
               WRITE(HSMG,'(2A,A12,A)') 'LCMEQU: TOO MANY DIRECTORY ',
     1         'LEVELS ON ''',NAMLCM,'''(7).'
               CALL XABORT(HSMG)
            ENDIF
            KJLON(ILEV)=ILONG
            IF(LCPUFM) THEN
            KDATA1(ILEV)=LCMGID(IPLIS1,NAMT)
            ENDIF
            KDATA2(ILEV)=LCMLID(IPLIS2,NAMT,ILONG)
            PATH(ILEV)=NAMT
            IF(LCPUFM) THEN
            IPLIS1=KDATA1(ILEV)
            ENDIF
            IPLIS2=KDATA2(ILEV)
            IVEC(ILEV)=0
            IGO(ILEV)=2
            GO TO 170
         ELSE IF((ILONG.NE.0).AND.(ITYLCM.LE.6)) THEN
            IF(IPRT.GT.0) WRITE(6,1010) ILEV,NAMT,ITYLCM,ILONG
*           DATA
            ALLOCATE(IASS(ILONG))
            IF(LCPUFM) THEN
               CALL LCMGET(IPLIS1,NAMT,IASS)
            ENDIF
            CALL MPI_BCAST(IASS,ILONG*M64,MPI_INTEGER,ICPUFM,
     1      ICOMM,IERR)
            CALL LCMPUT(IPLIS2,NAMT,ILONG,ITYLCM,IASS)
            DEALLOCATE(IASS)
         ENDIF
         IF(LCPUFM) THEN
         CALL LCMNXT(IPLIS1,NAMT)
         ENDIF
         CALL MPI_BCAST(NAMT,1,MPI_DIRNAME,ICPUFM,ICOMM,IERR)
         IF(NAMT.NE.FIRST(ILEV)) GO TO 130
         GO TO (160,160,190,190,200),IGO(ILEV)
*
  160    NAMT=PATH(ILEV)
         ILEV=ILEV-1
         IF(LCPUFM) THEN
         IPLIS1=KDATA1(ILEV)
         ENDIF
         IPLIS2=KDATA2(ILEV)
         IF(LCPUFM) THEN
         CALL LCMNXT(IPLIS1,NAMT)
         ENDIF
         CALL MPI_BCAST(NAMT,1,MPI_DIRNAME,ICPUFM,ICOMM,IERR)
         IF(NAMT.NE.FIRST(ILEV)) GO TO 130
         GO TO (160,160,190,190,200),IGO(ILEV)
*
*        LIST.
  170    IVEC(ILEV)=IVEC(ILEV)+1
         IF(IVEC(ILEV).GT.KJLON(ILEV)) THEN
            GO TO (160,160,190,190,200),IGO(ILEV)
         ENDIF
         IF(LCPUFM) THEN
         CALL LCMLEL(KDATA1(ILEV),IVEC(ILEV),ILONG,ITYLCM)
         ENDIF
         CALL MPI_BCAST(ILONG,1*M64,MPI_INTEGER,ICPUFM,ICOMM,IERR)
         CALL MPI_BCAST(ITYLCM,1*M64,MPI_INTEGER,ICPUFM,ICOMM,IERR)
         IF((ILONG.NE.0).AND.(ITYLCM.EQ.0)) THEN
            IF(IPRT.GT.0) WRITE(6,1010) ILEV,NAMT,ITYLCM,ILONG
*           ASSOCIATIVE TABLE DATA.
            ILEV=ILEV+1
            IF(ILEV.GT.MAXLEV) THEN
               WRITE(HSMG,'(2A,A12,A)') 'LCMEQU: TOO MANY DIRECTORY ',
     1         'LEVELS ON ''',NAMLCM,'''(8).'
               CALL XABORT(HSMG)
            ENDIF
            KJLON(ILEV)=-1
            IF(LCPUFM) THEN
            KDATA1(ILEV)=LCMGIL(IPLIS1,IVEC(ILEV-1))
            ENDIF
            KDATA2(ILEV)=LCMDIL(IPLIS2,IVEC(ILEV-1))
            IF(LCPUFM) THEN
            IPLIS1=KDATA1(ILEV)
            ENDIF
            IPLIS2=KDATA2(ILEV)
            IVEC(ILEV)=1
            IGO(ILEV)=3
            GO TO 120
         ELSE IF((ILONG.NE.0).AND.(ITYLCM.EQ.10)) THEN
            IF(IPRT.GT.0) WRITE(6,1010) ILEV,NAMT,ITYLCM,ILONG
*           LIST DATA.
            ILEV=ILEV+1
            IF(ILEV.GT.MAXLEV) THEN
               WRITE(HSMG,'(2A,A12,A)') 'LCMEQU: TOO MANY DIRECTORY ',
     1         'LEVELS ON ''',NAMLCM,'''(9).'
               CALL XABORT(HSMG)
            ENDIF
            KJLON(ILEV)=ILONG
            IF(LCPUFM) THEN
            KDATA1(ILEV)=LCMGIL(IPLIS1,IVEC(ILEV-1))
            ENDIF
            KDATA2(ILEV)=LCMLIL(IPLIS2,IVEC(ILEV-1),ILONG)
            IF(LCPUFM) THEN
            IPLIS1=KDATA1(ILEV)
            ENDIF
            IPLIS2=KDATA2(ILEV)
            IVEC(ILEV)=0
            IGO(ILEV)=4
            GO TO 170
         ELSE IF((ILONG.NE.0).AND.(ITYLCM.LE.6)) THEN
            IF(IPRT.GT.0) WRITE(6,1010) ILEV,NAMT,ITYLCM,ILONG
*           DATA
            ALLOCATE(IASS(ILONG))
            IF(LCPUFM) THEN
              CALL LCMGDL(IPLIS1,IVEC(ILEV),IASS)
            ENDIF
            CALL MPI_BCAST(IASS,ILONG*M64,MPI_INTEGER,ICPUFM,
     1      ICOMM,IERR)
            CALL LCMPDL(IPLIS2,IVEC(ILEV),ILONG,ITYLCM,IASS)
            DEALLOCATE(IASS)
         ENDIF
         GO TO 170
*
  190    ILEV=ILEV-1
         IF(LCPUFM) THEN
         IPLIS1=KDATA1(ILEV)
         ENDIF
         IPLIS2=KDATA2(ILEV)
         GO TO 170
*----
*  SENDING ITEM
*----
  191 IF(LALL)THEN
        IF(ITYPF.EQ.1.OR.ITYPF.EQ.5)THEN
          CALL MPI_BCAST(NITMAF,1*M64,MPI_INTEGER,ICPUFM,ICOMM,IERR)
        ELSEIF(ITYPF.EQ.2)THEN
          CALL MPI_BCAST(FLOTTF,1*M64,MPI_INTEGER,ICPUFM,ICOMM,IERR)
        ELSEIF(ITYPF.EQ.4)THEN
          CALL MPI_BCAST(DFLOTTF,2*M64,MPI_INTEGER,ICPUFM,ICOMM,IERR)
        ENDIF
        GO TO 199
      ENDIF
      IF(LCPUFM) THEN
        IF(ITYPF.EQ.1.OR.ITYPF.EQ.5)THEN
      CALL MPI_SEND(NITMAF,1*M64,MPI_INTEGER,ICPUTO,
     1           ITAG,ICOMM,IERR)
        ELSEIF(ITYPF.EQ.2)THEN
      CALL MPI_SEND(FLOTTF,1*M64,MPI_INTEGER,ICPUTO,
     1           ITAG,ICOMM,IERR)
        ELSEIF(ITYPF.EQ.4)THEN
      CALL MPI_SEND(DFLOTTF,2*M64,MPI_INTEGER,ICPUTO,
     1           ITAG,ICOMM,IERR)
        ENDIF
      ENDIF
      IF(LCPUTO) THEN
        IF(ITYPF.EQ.1.OR.ITYPF.EQ.5)THEN
          CALL MPI_RECV(NITMAF,1*M64,MPI_INTEGER,ICPUFM,
     1           ITAG,ICOMM,ISTATU,IERR)
        ELSEIF(ITYPF.EQ.2)THEN
          CALL MPI_RECV(FLOTTF,1*M64,MPI_INTEGER,ICPUFM,
     1           ITAG,ICOMM,ISTATU,IERR)
        ELSEIF(ITYPF.EQ.4)THEN
          CALL MPI_RECV(DFLOTTF,2*M64,MPI_INTEGER,ICPUFM,
     1           ITAG,ICOMM,ISTATU,IERR)
        ENDIF
      ENDIF
  199 CALL REDPUT(ITYPF,NITMAF,FLOTTF,TEXT12,DFLOTTF)

  200 RETURN
      STOP
*----
*  FORMAT
*----
 1010 FORMAT (1X,I5,3H  ',A12,1H',2I8)
 2000 FORMAT(38HSNDMPI: PROCESSOR NUMBER *FROM* SET TO,I4,
     1 30HINSTEAD OF BEING BETWEEN 0 AND,I4)
 2010 FORMAT(36HSNDMPI: PROCESSOR NUMBER *TO* SET TO,I4,
     1 30HINSTEAD OF BEING BETWEEN 0 AND,I4)
      END
#endif /* defined(MPI) */
