#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) */