Nature Language: multiplePingpong:With this algorithm multiple threads take place in the communication and computation. Each thread under the MPI ping process sends a portion of the message to the other MPI process. Each thread of the other process then sends it back to the first process.
  
CPP: int multiplePingpong(int totalReps, int dataSize){\n\tint repIter, i, lBound, uBound;\n\t/* Open parallel region for threads under pingRank */\n#pragma omp parallel default(none) \\\n\tprivate(i,repIter,lBound) \\\n\tshared(pingRank,pongRank,pingSendBuf,pingRecvBuf) \\\n\tshared(pongSendBuf,pongRecvBuf,finalRecvBuf,sizeofBuffer) \\\n\tshared(dataSize,globalIDarray,comm,status,totalReps,myMPIRank)\n\t{\n\tfor (repIter=0; repIter < totalReps; repIter++){\n\t\tif (myMPIRank == pingRank){\n\t\t\t/* Calculate lower bound of data array for the thread */\n\t\t\tlBound = (myThreadID * dataSize);\n\t\t\t/* All threads under MPI process with rank = pingRank\n\t\t\t * write to their part of the pingBuf array using\n\t\t\t * a parallel for directive.\n\t\t\t */\n#pragma omp for nowait schedule(static,dataSize)\n\t\t\tfor (i=0; i<sizeofBuffer; i++){\n\t\t\t\tpingSendBuf[i] = globalIDarray[myThreadID];\n\t\t\t}\n/* Implicit barrier not needed for multiple*/\n\t\t\t/*Each thread under ping process sends dataSize items\n\t\t\t * to MPI process with rank equal to pongRank.\n\t\t\t * myThreadID is used as tag to ensure data goes to correct\n\t\t\t * place in recv buffer.\n\t\t\t */\n\t\t\tMPI_Send(&pingSendBuf[lBound], dataSize, MPI_INT, pongRank, \\\n\t\t\t\t\tmyThreadID, comm);\n\t\t\t/* Thread then waits for a message from pong process. */\n\t\t\tMPI_Recv(&pongRecvBuf[lBound], dataSize, MPI_INT, pongRank, \\\n\t\t\t\t\tmyThreadID, comm, &status);\n\t\t\t/* Each thread reads its part of the received buffer */\n#pragma omp for nowait schedule(static,dataSize)\n\t\t\tfor (i=0; i<sizeofBuffer; i++){\n\t\t\t\tfinalRecvBuf[i] = pongRecvBuf[i];\n\t\t\t}\n\t\t}\n\t\telse if (myMPIRank == pongRank){\n\t\t\t/* Calculate lower bound of the data array */\n\t\t\tlBound = (myThreadID * dataSize);\n\t\t\t/* Each thread under pongRank receives a message\n\t\t\t * from the ping process.\n\t\t\t */\n\t\t\tMPI_Recv(&pingRecvBuf[lBound], dataSize, MPI_INT, pingRank, \\\n\t\t\t\t\tmyThreadID, comm, &status);\n\t\t\t/* Each thread now copies its part of the received buffer\n\t\t\t * to pongSendBuf.\n\t\t\t */\n#pragma omp for nowait schedule(static,dataSize)\n\t\t\tfor (i=0; i<sizeofBuffer; i++)\n\t\t\t{\n\t\t\t\tpongSendBuf[i] = pingRecvBuf[i];\n\t\t\t}\n\t\t\t/* Each thread now sends pongSendBuf to ping process. */\n\t\t\tMPI_Send(&pongSendBuf[lBound], dataSize, MPI_INT, pingRank, \\\n\t\t\t\t\tmyThreadID, comm);\n\t\t}\n\t}/* end of repetitions */\n\t} /* end of parallel region */\n\treturn 0;\n}
  
Fortran: SUBROUTINE multiplePingpong(totalReps, dataSize)\n integer, intent(in) :: totalReps, dataSize\n integer :: repIter, i\n integer :: lBound, uBound\n\n !Open parallel region for threads under pingRank\n!$OMP PARALLEL DEFAULT(NONE), &\n!$OMP PRIVATE(i,lBound,uBound,repIter,ierr,status), &\n!$OMP SHARED(myMPIRank,pingRank,pongRank,pingSendBuf,pingRecvBuf), &\n!$OMP SHARED(pongSendBuf,pongRecvBuf,finalRecvBuf,sizeofBuffer),&\n!$OMP SHARED(totalReps,dataSize,globalIDarray,comm)\n\n DO repIter = 1, totalReps !loop totalRep times\n\n IF (myMPIRank == pingRank) THEN\n \n !Calculate lower and upper bound of data array\n lBound = ((myThreadID-1)* dataSize) + 1\n uBound = (myThreadID * dataSize)\n \n !All threads under MPI process with rank = pingRank\n !write to its part of the pingBuf array using a \n !PARALLEL DO directive\n!$OMP DO SCHEDULE(STATIC,dataSize)\n DO i = 1,sizeofBuffer\n pingSendBuf(i) = globalIDarray(myThreadID)\n ENDDO\n!$OMP END DO NOWAIT\n!Implicit barrier at end of DO not needed for multiple\n\n !Each thread under Ping process sends dataSize items\n !to MPI process with rank equal to pongRank.\n !myThreadID is used as tag to ensure data goes to correct \n !place in buffer.\n CALL MPI_Send(pingSendBuf(lBound:uBound), dataSize,&\n MPI_INTEGER, pongRank, myThreadID, comm, ierr)\n \n !Thread then waits for a message from pong process.\n CALL MPI_Recv(pongRecvBuf(lBound:uBound), dataSize, &\n MPI_INTEGER, pongRank, myThreadID, comm, &\n status, ierr)\n\n !Each thread reads its part of received buffer.\n !This completes the pingpong operation.\n!$OMP DO SCHEDULE(STATIC,dataSize)\n DO i = 1,sizeofBuffer\n finalRecvBuf(i) = pongRecvBuf(i)\n ENDDO\n!$OMP END DO NOWAIT\n\n\n ELSEIF (myMPIRank == pongRank) THEN\n\n !Calculate lower and upper bound of data array\n lBound = ((myThreadID-1)* dataSize)+1\n uBound = (myThreadID * dataSize)\n\n\n !Each thread under pongRank receives a message \n !from the ping process\n CALL MPI_Recv(pingRecvBuf(lBound:uBound), dataSize, &\n MPI_INTEGER, pingRank, myThreadID, comm, &\n status, ierr)\n\n !Each thread under the pongRank MPI process now copies \n !its part of the received buffer to pongSendBuf\n\n!$OMP DO SCHEDULE(STATIC,dataSize)\n DO i = 1,sizeofBuffer\n pongSendBuf(i) = pingRecvBuf(i)\n END DO\n!$OMP END DO NOWAIT\n \n !Each thread now sends pongSendBuf to ping process.\n CALL MPI_Send(pongSendBuf(lBound:uBound), dataSize, &\n MPI_INTEGER, pingRank, myThreadID, comm, ierr)\n\n END IF\n END DO !End repetitions loop\n!$OMP END PARALLEL \n\n END SUBROUTINE multiplePingpong
  