<p><b>duda</b> 2009-08-12 15:24:01 -0600 (Wed, 12 Aug 2009)</p><p>Modifications to allow the code to be compiled without MPI.<br>
To compile without MPI, select appropriate serial compilers<br>
for FC and CC in the Makefile, and also remove -D_MPI from<br>
CPPFLAGS.<br>
<br>
Also, wrap lines longer than 132 characters.<br>
<br>
<br>
M module_dmpar.F<br>
M module_timer.F<br>
M module_block_decomp.F<br>
</p><hr noshade><pre><font color="gray">Modified: trunk/swmodel/module_block_decomp.F
===================================================================
--- trunk/swmodel/module_block_decomp.F 2009-08-12 21:15:59 UTC (rev 26)
+++ trunk/swmodel/module_block_decomp.F 2009-08-12 21:24:01 UTC (rev 27)
@@ -27,48 +27,54 @@
integer :: i, j, owner, iunit, istatus, local_nvertices
character (len=256) :: filename
- iunit = 50 + dminfo % my_proc_id
- if (dminfo % nprocs < 10) then
- write(filename,'(a,i1)') 'graph.info.part.', dminfo % nprocs
- else if (dminfo % nprocs < 100) then
- write(filename,'(a,i2)') 'graph.info.part.', dminfo % nprocs
- else if (dminfo % nprocs < 1000) then
- write(filename,'(a,i3)') 'graph.info.part.', dminfo % nprocs
- else if (dminfo % nprocs < 10000) then
- write(filename,'(a,i4)') 'graph.info.part.', dminfo % nprocs
- else if (dminfo % nprocs < 100000) then
- write(filename,'(a,i5)') 'graph.info.part.', dminfo % nprocs
- end if
-
- open(unit=iunit, file=trim(filename), form='formatted', status='old', iostat=istatus)
+ if (dminfo % nprocs > 1) then
- if (istatus /= 0) then
- write(0,*) 'Could not open block decomposition file for ',dminfo % nprocs,' tasks.'
- write(0,*) 'Filename: ',trim(filename)
- call dmpar_abort(dminfo)
- end if
-
- local_nvertices = 0
- do i=1,partial_global_graph_info % nVerticesTotal
- read(unit=iunit, fmt=*) owner
- if (owner == dminfo % my_proc_id) local_nvertices = local_nvertices + 1
- end do
-
- allocate(local_cell_list(local_nvertices))
-
- rewind(unit=iunit)
-
- j = 0
- do i=1,partial_global_graph_info % nVerticesTotal
- read(unit=iunit, fmt=*) owner
- if (owner == dminfo % my_proc_id) then
- j = j + 1
- local_cell_list(j) = i
+ iunit = 50 + dminfo % my_proc_id
+ if (dminfo % nprocs < 10) then
+ write(filename,'(a,i1)') 'graph.info.part.', dminfo % nprocs
+ else if (dminfo % nprocs < 100) then
+ write(filename,'(a,i2)') 'graph.info.part.', dminfo % nprocs
+ else if (dminfo % nprocs < 1000) then
+ write(filename,'(a,i3)') 'graph.info.part.', dminfo % nprocs
+ else if (dminfo % nprocs < 10000) then
+ write(filename,'(a,i4)') 'graph.info.part.', dminfo % nprocs
+ else if (dminfo % nprocs < 100000) then
+ write(filename,'(a,i5)') 'graph.info.part.', dminfo % nprocs
end if
- end do
+
+ open(unit=iunit, file=trim(filename), form='formatted', status='old', iostat=istatus)
+
+ if (istatus /= 0) then
+ write(0,*) 'Could not open block decomposition file for ',dminfo % nprocs,' tasks.'
+ write(0,*) 'Filename: ',trim(filename)
+ call dmpar_abort(dminfo)
+ end if
+
+ local_nvertices = 0
+ do i=1,partial_global_graph_info % nVerticesTotal
+ read(unit=iunit, fmt=*) owner
+ if (owner == dminfo % my_proc_id) local_nvertices = local_nvertices + 1
+ end do
+
+ allocate(local_cell_list(local_nvertices))
+
+ rewind(unit=iunit)
+
+ j = 0
+ do i=1,partial_global_graph_info % nVerticesTotal
+ read(unit=iunit, fmt=*) owner
+ if (owner == dminfo % my_proc_id) then
+ j = j + 1
+ local_cell_list(j) = i
+ end if
+ end do
+
+ close(unit=iunit)
+ else
+ allocate(local_cell_list(partial_global_graph_info % nVerticesTotal))
+ local_cell_list(:) = dminfo % my_proc_id
+ endif
- close(unit=iunit)
-
end subroutine block_decomp_cells_for_proc
@@ -208,7 +214,8 @@
call hash_init(h)
do i=1,local_graph_info % nVertices
-if (hash_search(h, local_graph_info % vertexID(i))) write(0,*) 'block_decomp_add_halo: There appear to be duplicates in vertexID list.'
+if (hash_search(h, local_graph_info % vertexID(i))) &
+ write(0,*) 'block_decomp_add_halo: There appear to be duplicates in vertexID list.'
call hash_insert(h, local_graph_info % vertexID(i))
local_graph_with_halo % vertexID(i) = local_graph_info % vertexID(i)
local_graph_with_halo % nAdjacent(i) = local_graph_info % nAdjacent(i)
@@ -216,7 +223,8 @@
end do
k = local_graph_with_halo % ghostStart
-if (hash_size(h) /= k-1) write(0,*) 'block_decomp_add_halo: Somehow we don''t have the right number of non-ghost cells.'
+if (hash_size(h) /= k-1) &
+ write(0,*) 'block_decomp_add_halo: Somehow we don''t have the right number of non-ghost cells.'
do i=1,local_graph_info % nVertices
do j=1,local_graph_info % nAdjacent(i)
if (.not. hash_search(h, local_graph_info % adjacencyList(j,i))) then
@@ -226,7 +234,8 @@
end if
end do
end do
-if (local_graph_with_halo % nVerticesTotal /= k-1) write(0,*) 'block_decomp_add_halo: Somehow we don''t have the right number of total cells.'
+if (local_graph_with_halo % nVerticesTotal /= k-1) &
+ write(0,*) 'block_decomp_add_halo: Somehow we don''t have the right number of total cells.'
call hash_destroy(h)
Modified: trunk/swmodel/module_dmpar.F
===================================================================
--- trunk/swmodel/module_dmpar.F 2009-08-12 21:15:59 UTC (rev 26)
+++ trunk/swmodel/module_dmpar.F 2009-08-12 21:24:01 UTC (rev 27)
@@ -4,13 +4,13 @@
#ifdef _MPI
include 'mpif.h'
-#endif
#if (RKIND == 8)
integer, parameter :: MPI_REALKIND = MPI_DOUBLE_PRECISION
#else
integer, parameter :: MPI_REALKIND = MPI_REAL
#endif
+#endif
integer, parameter :: IO_NODE = 0
integer, parameter :: BUFSIZE = 6000
@@ -65,14 +65,13 @@
call open_streams(dminfo % my_proc_id)
+ dminfo % info = MPI_INFO_NULL
#else
dminfo % comm = 0
dminfo % my_proc_id = IO_NODE
dminfo % nprocs = 1
#endif
- dminfo % info = MPI_INFO_NULL
-
end subroutine dmpar_init
@@ -118,7 +117,11 @@
integer :: mpi_ierr
+#ifdef _MPI
call MPI_Allreduce(i, isum, 1, MPI_INTEGER, MPI_SUM, dminfo % comm, mpi_ierr)
+#else
+ isum = i
+#endif
end subroutine dmpar_sum_int
@@ -158,6 +161,7 @@
global_start = 1
global_end = global_start + n - 1
+#ifdef _MPI
else if (dminfo % my_proc_id == dminfo % nprocs - 1) then
call MPI_Recv(global_start, 1, MPI_INTEGER, dminfo % my_proc_id - 1, 0, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
global_end = global_start + n - 1
@@ -167,6 +171,7 @@
global_end = global_start + n
call MPI_Send(global_end, 1, MPI_INTEGER, dminfo % my_proc_id + 1, 0, dminfo % comm, mpi_ierr)
global_end = global_end - 1
+#endif
end if
@@ -192,6 +197,7 @@
integer :: mpi_ierr
+#ifdef _MPI
nLoop = dminfo % nprocs / 2
allocate(buffer(BUFSIZE))
@@ -241,7 +247,8 @@
do while (istart <= recvListPtr % nlist)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf1dInteger(nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf1dInteger(nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -251,7 +258,8 @@
do while (istart <= recvListPtr % nlist)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf1dInteger(nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf1dInteger(nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -272,7 +280,8 @@
do while (istart <= recvListPtr % nlist)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf1dInteger(nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf1dInteger(nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -300,7 +309,8 @@
do while (istart <= recvListPtr % nlist)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf1dInteger(nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf1dInteger(nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -310,6 +320,14 @@
end do
deallocate(buffer)
+#else
+ if (nOwnedList /= nNeededList) then
+ write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, arrayIn and arrayOut dims must match.'
+ call dmpar_abort(dminfo)
+ else
+ arrayOut(:) = arrayIn(:)
+ end if
+#endif
end subroutine dmpar_alltoall_field1dInteger
@@ -333,6 +351,7 @@
integer :: d1
+#ifdef _MPI
nLoop = dminfo % nprocs / 2
d1 = dim1
@@ -373,7 +392,8 @@
if (isInList(leftNeighbor, sendList, sendListPtr)) then
istart = 1
do while (istart <= sendListPtr % nlist)
- call packSendBuf2dInteger(1, d1, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, lastPackedIdx)
+ call packSendBuf2dInteger(1, d1, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, &
+ lastPackedIdx)
call MPI_Send(nSendBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, mpi_ierr)
call MPI_Send(buffer, nSendBuf, MPI_INTEGER, leftNeighbor, i, dminfo % comm, mpi_ierr)
istart = lastPackedIdx + 1
@@ -384,7 +404,8 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf2dInteger(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf2dInteger(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -394,14 +415,16 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf2dInteger(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf2dInteger(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked,
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
if (isInList(rightNeighbor, sendList, sendListPtr)) then
istart = 1
do while (istart <= sendListPtr % nlist)
- call packSendBuf2dInteger(1, d1, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, lastPackedIdx)
+ call packSendBuf2dInteger(1, d1, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, &
+ lastPackedIdx)
call MPI_Send(nSendBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, mpi_ierr)
call MPI_Send(buffer, nSendBuf, MPI_INTEGER, rightNeighbor, i, dminfo % comm, mpi_ierr)
istart = lastPackedIdx + 1
@@ -415,14 +438,16 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf2dInteger(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf2dInteger(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked,
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
if (isInList(rightNeighbor, sendList, sendListPtr)) then
istart = 1
do while (istart <= sendListPtr % nlist)
- call packSendBuf2dInteger(1, d1, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, lastPackedIdx)
+ call packSendBuf2dInteger(1, d1, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, &
+ lastPackedIdx)
call MPI_Send(nSendBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, mpi_ierr)
call MPI_Send(buffer, nSendBuf, MPI_INTEGER, rightNeighbor, i, dminfo % comm, mpi_ierr)
istart = lastPackedIdx + 1
@@ -432,7 +457,8 @@
if (isInList(leftNeighbor, sendList, sendListPtr)) then
istart = 1
do while (istart <= sendListPtr % nlist)
- call packSendBuf2dInteger(1, d1, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, lastPackedIdx)
+ call packSendBuf2dInteger(1, d1, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, &
+ lastPackedIdx)
call MPI_Send(nSendBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, mpi_ierr)
call MPI_Send(buffer, nSendBuf, MPI_INTEGER, leftNeighbor, i, dminfo % comm, mpi_ierr)
istart = lastPackedIdx + 1
@@ -443,7 +469,8 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf2dInteger(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf2dInteger(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -453,6 +480,14 @@
end do
deallocate(buffer)
+#else
+ if (nOwnedList /= nNeededList) then
+ write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, arrayIn and arrayOut dims must match.'
+ call dmpar_abort(dminfo)
+ else
+ arrayOut(:,:) = arrayIn(:,:)
+ end if
+#endif
end subroutine dmpar_alltoall_field2dInteger
@@ -623,6 +658,7 @@
logical :: needToRecv
integer :: mpi_ierr
+#ifdef _MPI
do i=1,nOwnedList
ownedListSorted(1,i) = ownedList(i)
ownedListSorted(2,i) = i
@@ -902,7 +938,26 @@
deallocate(recvListPtr)
call MPI_Barrier(dminfo % comm, mpi_ierr)
+#else
+ allocate(recvList)
+ recvList % procID = dminfo % my_proc_id
+ recvList % nlist = nNeededList
+ allocate(recvList % list(nNeededList))
+ nullify(recvList % next)
+ do j=1,nNeededList
+ recvList % list(j) = j
+ end do
+ allocate(sendList)
+ sendList % procID = dminfo % my_proc_id
+ sendList % nlist = nOwnedList
+ allocate(sendList % list(nOwnedList))
+ nullify(sendList % next)
+ do j=1,nOwnedList
+ sendList % list(j) = j
+ end do
+#endif
+
end subroutine dmpar_get_owner_list
@@ -924,6 +979,7 @@
integer :: mpi_ierr
+#ifdef _MPI
nLoop = dminfo % nprocs / 2
allocate(buffer(BUFSIZE))
@@ -983,7 +1039,8 @@
do while (istart <= recvListPtr % nlist)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf1dReal(nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf1dReal(nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -1032,7 +1089,8 @@
do while (istart <= recvListPtr % nlist)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf1dReal(nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf1dReal(nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -1042,6 +1100,14 @@
end do
deallocate(buffer)
+#else
+ if (nOwnedList /= nNeededList) then
+ write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, arrayIn and arrayOut dims must match.'
+ call dmpar_abort(dminfo)
+ else
+ arrayOut(:) = arrayIn(:)
+ end if
+#endif
end subroutine dmpar_alltoall_field1dReal
@@ -1065,6 +1131,7 @@
integer :: d1
+#ifdef _MPI
nLoop = dminfo % nprocs / 2
d1 = dim1
@@ -1116,7 +1183,8 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf2dReal(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf2dReal(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -1126,14 +1194,16 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf2dReal(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf2dReal(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
if (isInList(rightNeighbor, sendList, sendListPtr)) then
istart = 1
do while (istart <= sendListPtr % nlist)
- call packSendBuf2dReal(1, d1, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, lastPackedIdx)
+ call packSendBuf2dReal(1, d1, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, &
+ lastPackedIdx)
call MPI_Send(nSendBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, mpi_ierr)
call MPI_Send(buffer, nSendBuf, MPI_REALKIND, rightNeighbor, i, dminfo % comm, mpi_ierr)
istart = lastPackedIdx + 1
@@ -1147,7 +1217,8 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf2dReal(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf2dReal(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -1164,7 +1235,8 @@
if (isInList(leftNeighbor, sendList, sendListPtr)) then
istart = 1
do while (istart <= sendListPtr % nlist)
- call packSendBuf2dReal(1, d1, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, lastPackedIdx)
+ call packSendBuf2dReal(1, d1, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, &
+ lastPackedIdx)
call MPI_Send(nSendBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, mpi_ierr)
call MPI_Send(buffer, nSendBuf, MPI_REALKIND, leftNeighbor, i, dminfo % comm, mpi_ierr)
istart = lastPackedIdx + 1
@@ -1175,7 +1247,8 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf2dReal(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf2dReal(1, d1, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -1185,6 +1258,14 @@
end do
deallocate(buffer)
+#else
+ if (nOwnedList /= nNeededList) then
+ write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, arrayIn and arrayOut dims must match.'
+ call dmpar_abort(dminfo)
+ else
+ arrayOut(:,:) = arrayIn(:,:)
+ end if
+#endif
end subroutine dmpar_alltoall_field2dReal
@@ -1208,6 +1289,7 @@
integer :: d1, d2
+#ifdef _MPI
nLoop = dminfo % nprocs / 2
d1 = dim1
@@ -1249,7 +1331,8 @@
if (isInList(leftNeighbor, sendList, sendListPtr)) then
istart = 1
do while (istart <= sendListPtr % nlist)
- call packSendBuf3dReal(1, d1, 1, d2, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, lastPackedIdx)
+ call packSendBuf3dReal(1, d1, 1, d2, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, &
+ lastPackedIdx)
call MPI_Send(nSendBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, mpi_ierr)
call MPI_Send(buffer, nSendBuf, MPI_REALKIND, leftNeighbor, i, dminfo % comm, mpi_ierr)
istart = lastPackedIdx + 1
@@ -1260,7 +1343,8 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf3dReal(1, d1, 1, d2, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf3dReal(1, d1, 1, d2, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -1270,14 +1354,16 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf3dReal(1, d1, 1, d2, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf3dReal(1, d1, 1, d2, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, &
+ nUnpacked, lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
if (isInList(rightNeighbor, sendList, sendListPtr)) then
istart = 1
do while (istart <= sendListPtr % nlist)
- call packSendBuf3dReal(1, d1, 1, d2, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, lastPackedIdx)
+ call packSendBuf3dReal(1, d1, 1, d2, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, &
+ lastPackedIdx)
call MPI_Send(nSendBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, mpi_ierr)
call MPI_Send(buffer, nSendBuf, MPI_REALKIND, rightNeighbor, i, dminfo % comm, mpi_ierr)
istart = lastPackedIdx + 1
@@ -1291,14 +1377,16 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf3dReal(1, d1, 1, d2, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf3dReal(1, d1, 1, d2, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
if (isInList(rightNeighbor, sendList, sendListPtr)) then
istart = 1
do while (istart <= sendListPtr % nlist)
- call packSendBuf3dReal(1, d1, 1, d2, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, lastPackedIdx)
+ call packSendBuf3dReal(1, d1, 1, d2, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, &
+ lastPackedIdx)
call MPI_Send(nSendBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, mpi_ierr)
call MPI_Send(buffer, nSendBuf, MPI_REALKIND, rightNeighbor, i, dminfo % comm, mpi_ierr)
istart = lastPackedIdx + 1
@@ -1308,7 +1396,8 @@
if (isInList(leftNeighbor, sendList, sendListPtr)) then
istart = 1
do while (istart <= sendListPtr % nlist)
- call packSendBuf3dReal(1, d1, 1, d2, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, lastPackedIdx)
+ call packSendBuf3dReal(1, d1, 1, d2, nOwnedList, arrayIn, sendListPtr, istart, BUFSIZE, buffer, nSendBuf, &
+ lastPackedIdx)
call MPI_Send(nSendBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, mpi_ierr)
call MPI_Send(buffer, nSendBuf, MPI_REALKIND, leftNeighbor, i, dminfo % comm, mpi_ierr)
istart = lastPackedIdx + 1
@@ -1319,7 +1408,8 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf3dReal(1, d1, 1, d2, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf3dReal(1, d1, 1, d2, nNeededList, arrayOut, recvListPtr, istart, BUFSIZE, buffer, &
+ nUnpacked, lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -1329,6 +1419,14 @@
end do
deallocate(buffer)
+#else
+ if (nOwnedList /= nNeededList) then
+ write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, arrayIn and arrayOut dims must match.'
+ call dmpar_abort(dminfo)
+ else
+ arrayOut(:,:,:) = arrayIn(:,:,:)
+ end if
+#endif
end subroutine dmpar_alltoall_field3dReal
@@ -1490,7 +1588,8 @@
end subroutine unpackRecvBuf2dReal
- subroutine unpackRecvBuf3dReal(d1s, d1e, d2s, d2e, nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)
+ subroutine unpackRecvBuf3dReal(d1s, d1e, d2s, d2e, nField, field, recvList, startUnpackIdx, nBuffer, buffer, &
+ nUnpacked, lastUnpackedIdx)
implicit none
@@ -1542,7 +1641,7 @@
integer :: mpi_ierr
integer :: d1, d2
-
+#ifdef _MPI
nLoop = dminfo % nprocs / 2
d1 = dim1
@@ -1658,6 +1757,7 @@
end do
deallocate(buffer)
+#endif
end subroutine dmpar_exch_halo_field2dReal
@@ -1680,6 +1780,7 @@
integer :: d1, d2, d3
+#ifdef _MPI
nLoop = dminfo % nprocs / 2
d1 = dim1
@@ -1727,7 +1828,8 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf3dReal(1, d1, 1, d2, d3, array, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf3dReal(1, d1, 1, d2, d3, array, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -1737,7 +1839,8 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf3dReal(1, d1, 1, d2, d3, array, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf3dReal(1, d1, 1, d2, d3, array, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -1758,7 +1861,8 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, rightNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf3dReal(1, d1, 1, d2, d3, array, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf3dReal(1, d1, 1, d2, d3, array, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -1786,7 +1890,8 @@
do while (istart <= recvListPtr % nList)
call MPI_Recv(nRecvBuf, 1, MPI_INTEGER, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
call MPI_Recv(buffer, nRecvBuf, MPI_REALKIND, leftNeighbor, i, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
- call unpackRecvBuf3dReal(1, d1, 1, d2, d3, array, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, lastUnpackedIdx)
+ call unpackRecvBuf3dReal(1, d1, 1, d2, d3, array, recvListPtr, istart, BUFSIZE, buffer, nUnpacked, &
+ lastUnpackedIdx)
istart = lastUnpackedIdx + 1
end do
end if
@@ -1796,6 +1901,7 @@
end do
deallocate(buffer)
+#endif
end subroutine dmpar_exch_halo_field3dReal
Modified: trunk/swmodel/module_timer.F
===================================================================
--- trunk/swmodel/module_timer.F 2009-08-12 21:15:59 UTC (rev 26)
+++ trunk/swmodel/module_timer.F 2009-08-12 21:24:01 UTC (rev 27)
@@ -65,7 +65,9 @@
SAVE
PRIVATE
+#ifdef _MPI
include 'mpif.h'
+#endif
TYPE timer_node
CHARACTER (LEN=72) :: event_name
@@ -278,7 +280,9 @@
CALL system_clock (count_rate=hz)
wall_now = REAL (clock)/REAL (hz)
+#ifdef _MPI
CALL MPI_BARRIER (MPI_COMM_WORLD,ierr)
+#endif
IF (.NOT.ASSOCIATED (timer_events)) THEN
PRINT *,' timer_write :: timer_write called with no events initiated '
@@ -365,12 +369,16 @@
ENDDO
ENDIF
+#ifdef _MPI
CALL MPI_BARRIER (MPI_COMM_WORLD,ierr)
+#endif
ENDDO
ENDIF
+#ifdef _MPI
CALL MPI_BARRIER (MPI_COMM_WORLD,ierr)
+#endif
10 FORMAT (1x,i5,' : ',a20,l1,2f15.5,f8.2)
20 FORMAT (1x,i5,' : ',a20,l1,2f15.5 )
</font>
</pre>