From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001 From: stainer_t Date: Mon, 8 Sep 2025 13:48:49 +0200 Subject: Initial commit from Polytechnique Montreal --- Ganlib/src/SNDMPI.F | 616 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 616 insertions(+) create mode 100644 Ganlib/src/SNDMPI.F (limited to 'Ganlib/src/SNDMPI.F') 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) */ -- cgit v1.2.3