summaryrefslogtreecommitdiff
path: root/Ganlib/src/SNDMPI.F
diff options
context:
space:
mode:
Diffstat (limited to 'Ganlib/src/SNDMPI.F')
-rw-r--r--Ganlib/src/SNDMPI.F616
1 files changed, 616 insertions, 0 deletions
diff --git a/Ganlib/src/SNDMPI.F b/Ganlib/src/SNDMPI.F
new file mode 100644
index 0000000..0023cfc
--- /dev/null
+++ b/Ganlib/src/SNDMPI.F
@@ -0,0 +1,616 @@
+#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,2020) NAMLCM,1
+ 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,2020) NAMLCM,2
+ 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,2020) NAMLCM,3
+ 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,2020) NAMLCM,4
+ 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,2020) NAMLCM,5
+ 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,2020) NAMLCM,6
+ 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,2020) NAMLCM,7
+ 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,2020) NAMLCM,8
+ 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)
+ 2020 FORMAT(37HSNDMPI: TOO MANY DIRECTORY LEVELS ON ,A,2H (,I1,2H).)
+ END
+#endif /* defined(MPI) */
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 11:15:31 +0000