Imported mpi-serial changes from MCSclimate/mpi-serial

src/externals/mct/mpi-serial/Makefile

@@ -88,3 +88,6 @@ install: lib
 	$(INSTALL) lib$(MODULE).a -m 644 $(libdir)
 	$(INSTALL) mpi.h -m 644 $(includedir)
 	$(INSTALL) mpif.h -m 644 $(includedir)
+
+
+

src/externals/mct/mpi-serial/mpi.c

@@ -323,7 +323,21 @@ int MPI_Get_library_version(char *version, int *resultlen)
   return(MPI_SUCCESS);
 }
 
+/**********/
+void FC_FUNC( mpi_get_version, MPI_GET_VERSION )(int *mpi_vers, int *mpi_subvers, int *ierror)
+{
+  MPI_Get_Version(mpi_vers, mpi_subvers);
+
+  *ierror=MPI_SUCCESS;
+}
+
+int MPI_Get_Version(int *mpi_vers, int *mpi_subvers)
+{
+  *mpi_vers = 1;
+  *mpi_subvers = 0;
 
+  return (MPI_SUCCESS);
+}
 
 /**********/
 

src/externals/mct/mpi-serial/mpif.h

@@ -325,3 +325,11 @@ parameter (MPI_BOTTOM=0)
 
   INTEGER MPI_MAX_LIBRARY_VERSION_STRING
   PARAMETER (MPI_MAX_LIBRARY_VERSION_STRING=80)
+
+  !
+  ! MPI Version
+  !
+  INTEGER MPI_VERSION
+  PARAMETER (MPI_VERSION=1)
+  INTEGER MPI_SUBVERSION
+  PARAMETER (MPI_SUBVERSION=0)

src/externals/mct/mpi-serial/tests/ftest.F90

@@ -7,8 +7,8 @@ program test
       implicit none
         integer ierr
         integer ec
-	character*(MPI_MAX_LIBRARY_VERSION_STRING) version
-	integer vlen
+        character*(MPI_MAX_LIBRARY_VERSION_STRING) version
+        integer vlen
 
         ec = 0
 #ifdef TEST_INTERNAL
@@ -17,8 +17,8 @@ program test
 
         call mpi_init(ierr)
 
-	call MPI_GET_LIBRARY_VERSION(version,vlen,ierr)
-	print *,"MPI Version '",version,"' len=",vlen
+        call MPI_GET_LIBRARY_VERSION(version,vlen,ierr)
+        print *,"MPI Version '",version,"' len=",vlen
 
         call test_contiguous(ec)
         call test_vector(ec)
@@ -31,6 +31,7 @@ program test
         call test_multiple(ec)
         call test_multiple_indexed(ec)
         call test_collectives(ec)
+        call test_mpi_version(ec)
 
         call mpi_finalize(ierr)
         if (ec .eq. 0) then
@@ -678,3 +679,31 @@ subroutine test_collectives(ec)
         end do
       end subroutine
 
+!!!!!!!!!!!!!!!!!!!!!!!!
+! Test MPI_VERSION
+!!!!!!!!!!!!!!!!!!!!!!!!
+
+      subroutine test_mpi_version(ec)
+      use mpi
+      integer ec
+      integer ierr
+      integer mpiv
+      integer mpisv
+
+      print *, "Testing MPI_Get_Version"
+
+      call mpi_get_version(mpiv, mpisv, ierr)
+      if (ierr /= MPI_SUCCESS) then
+        print *, "MPI_get_VERSION ierr not zero (",ierr,")"
+        ec = ec + 1
+      else
+        if (mpiv /= MPI_VERSION) then
+          print *, "MPI_VERSION mismatch, should be ",MPI_VERSION,", found ",mpiv
+          ec = ec + 1
+        end if
+        if (mpisv /= MPI_SUBVERSION) then
+          print *, "MPI_SUBVERSION mismatch, should be ",MPI_SUBVERSION,", found ",mpisv
+          ec = ec + 1
+        end if
+      end if
+      end subroutine test_mpi_version

src/externals/mct/mpi-serial/tests/ftest_old.F90

@@ -1,163 +1,165 @@
-program test
-  implicit none
-  include "mpif.h"
 
-  integer ier
+	program test
+	implicit none
+	include "mpif.h"
 
-  integer sreq(10), sreq2(10), rreq(10), rreq2(10)
-  integer sbuf(10), sbuf2(10), rbuf(10), rbuf2(10)
-  integer tag
-  integer status(MPI_STATUS_SIZE,10)
-  integer i
-  integer comm2;
-  logical flag;
-  character pname(MPI_MAX_PROCESSOR_NAME)
-  integer pnamesize
+	integer ier
 
-  integer temp,position
-  integer errcount
+	integer sreq(10), sreq2(10), rreq(10), rreq2(10)
+	integer sbuf(10), sbuf2(10), rbuf(10), rbuf2(10)
+	integer tag
+	integer status(MPI_STATUS_SIZE,10)
+	integer i
+	integer comm2;
+	logical flag;
+	character pname(MPI_MAX_PROCESSOR_NAME)
+	integer pnamesize
 
-  errcount = 0
+        integer temp,position
+        integer errcount
 
-  print *, 'Time=',mpi_wtime()
+        errcount = 0
 
-  call mpi_initialized(flag,ier)
-  print *, 'MPI is initialized=',flag
+        print *, 'Time=',mpi_wtime()
 
-  call mpi_init(ier)
+	call mpi_initialized(flag,ier)
+	print *, 'MPI is initialized=',flag
 
-  call mpi_get_processor_name(pname,pnamesize,ier)
-  print *, 'proc name: "',pname(1:pnamesize),'"  size:',pnamesize
+	call mpi_init(ier)
 
+	call mpi_get_processor_name(pname,pnamesize,ier)
+	print *, 'proc name: "',pname(1:pnamesize),'"  size:',pnamesize
 
-  call mpi_comm_dup(MPI_COMM_WORLD,comm2,ier)
 
-  call mpi_initialized(flag,ier)
-  print *, 'MPI is initialized=',flag
+	call mpi_comm_dup(MPI_COMM_WORLD,comm2,ier)
 
+	call mpi_initialized(flag,ier)
+	print *, 'MPI is initialized=',flag
 
 
 
-  do i=1,5
-    tag= 100+i
-    print *,  'Post receive tag ',tag
 
-    call mpi_irecv( rbuf(i),1,MPI_INTEGER,0,tag, &
-         MPI_COMM_WORLD,rreq(i),ier)
+	do i=1,5
+	  tag= 100+i
+	  print *,  'Post receive tag ',tag
 
-  end do
-  do i=1,5
-    !     tag=1100+i
-    !     print *,  'Post receive tag ',tag
+	  call mpi_irecv( rbuf(i),1,MPI_INTEGER,0,tag, &
+                          MPI_COMM_WORLD,rreq(i),ier)
 
-    call mpi_irecv( rbuf2(i),1,MPI_INTEGER, &
-         MPI_ANY_SOURCE, MPI_ANY_TAG, &
-         comm2,rreq2(i),ier)
+	end do
+	do i=1,5
+!	  tag=1100+i
+!	  print *,  'Post receive tag ',tag
 
-  end do
+	  call mpi_irecv( rbuf2(i),1,MPI_INTEGER, &
+                          MPI_ANY_SOURCE, MPI_ANY_TAG, &
+                          comm2,rreq2(i),ier)
 
+	end do
 
-  do i=1,5
-    sbuf(i)=10*i
-    tag=100+i
-    print *, 'Send ',sbuf(i),' tag ',tag
 
-    call mpi_isend( sbuf(i),1,MPI_INTEGER,0,tag, &
-         MPI_COMM_WORLD,sreq(i),ier)
-  end do
+	do i=1,5
+	  sbuf(i)=10*i
+	  tag=100+i
+	  print *, 'Send ',sbuf(i),' tag ',tag
 
+	  call mpi_isend( sbuf(i),1,MPI_INTEGER,0,tag, &
+	                  MPI_COMM_WORLD,sreq(i),ier)
+	end do
 
-  do i=1,5
-    sbuf2(i)=1000+10*i
-    tag=1100+i
-    print *, 'Send ',sbuf2(i),' tag ',tag
 
-    call mpi_isend( sbuf2(i),1,MPI_INTEGER,0,tag, &
-         comm2,sreq2(i),ier)
-  end do
+	do i=1,5
+	  sbuf2(i)=1000+10*i
+	  tag=1100+i
+	  print *, 'Send ',sbuf2(i),' tag ',tag
 
-  do i=1,5
-    if (sbuf(i) .ne. rbuf(i)) then
-      errcount = errcount+1
-      print *, 'error on Send2'
-      print *, 'found ',sbuf2(i),' should be ',rbuf2(i)
-    end if
-  end do
+	  call mpi_isend( sbuf2(i),1,MPI_INTEGER,0,tag, &
+	                  comm2,sreq2(i),ier)
+	end do
 
-  do i=1,5
-    if (sbuf2(i) .ne. rbuf2(i)) then
-      errcount = errcount+1
-      print *, 'error on Send2'
-      print *, 'found ',sbuf2(i),' should be ',rbuf2(i)
-    end if
-  end do
+        do i=1,5
+          if (sbuf(i) .ne. rbuf(i)) then
+            errcount = errcount+1
+            print *, 'error on Send2'
+            print *, 'found ',sbuf2(i),' should be ',rbuf2(i)
+          end if
+        end do
 
-  print *, 'Time=',mpi_wtime()
-  call mpi_waitall(5,sreq,status,ier)
-  print *,'sends on MPI_COMM_WORLD done'
+        do i=1,5
+          if (sbuf2(i) .ne. rbuf2(i)) then
+            errcount = errcount+1
+            print *, 'error on Send2'
+            print *, 'found ',sbuf2(i),' should be ',rbuf2(i)
+          end if
+        end do
 
-  call mpi_waitall(5,rreq,status,ier)
-  print *,'recvs on MPI_COMM_WORLD done'
+        print *, 'Time=',mpi_wtime()
+	call mpi_waitall(5,sreq,status,ier)
+	print *,'sends on MPI_COMM_WORLD done'
 
-  do i=1,5
-    print *, 'Status source=',status(MPI_SOURCE,i), &
-         '  tag=',status(MPI_TAG,i)
-  end do
+	call mpi_waitall(5,rreq,status,ier)
+	print *,'recvs on MPI_COMM_WORLD done'
+
+	do i=1,5
+          print *, 'Status source=',status(MPI_SOURCE,i), &
+                   '  tag=',status(MPI_TAG,i)
+	end do
 
-  call mpi_waitall(5,sreq2,status,ier)
-  print *,'sends on comm2 done'
+	call mpi_waitall(5,sreq2,status,ier)
+	print *,'sends on comm2 done'
 
-  call mpi_waitall(5,rreq2,status,ier)
-  print *,'recvs on comm2 done'
+	call mpi_waitall(5,rreq2,status,ier)
+	print *,'recvs on comm2 done'
 
-  do i=1,5
-    print *, 'Status source=',status(MPI_SOURCE,i), &
-         '  tag=',status(MPI_TAG,i)
-  end do
+	do i=1,5
+          print *, 'Status source=',status(MPI_SOURCE,i), &
+                   '  tag=',status(MPI_TAG,i)
+	end do
 
 
-  ! pack/unpack
+! pack/unpack
 
-  position=0
-  do i=1,5
-    temp=100+i
-    call mpi_pack(temp,1,MPI_INTEGER,sbuf,20,position,MPI_COMM_WORLD,ier)
-  end do
+	position=0
+	do i=1,5
+          temp=100+i
+	  call mpi_pack(temp,1,MPI_INTEGER,sbuf,20,position,MPI_COMM_WORLD,ier)
+ 	end do
 
-  call mpi_isend(sbuf,position,MPI_PACKED,0,0,MPI_COMM_WORLD,sreq(1),ier)
-  call mpi_irecv(rbuf,position,MPI_PACKED,0,0,MPI_COMM_WORLD,rreq(1),ier)
-  call mpi_waitall(1,rreq,status,ier)
+        call mpi_isend(sbuf,position,MPI_PACKED,0,0,MPI_COMM_WORLD,sreq(1),ier)
+	call mpi_irecv(rbuf,position,MPI_PACKED,0,0,MPI_COMM_WORLD,rreq(1),ier)
+        call mpi_waitall(1,rreq,status,ier)
 
-  print *,"Pack/send/unpack:"
+        print *,"Pack/send/unpack:"
 
-  position=0
-  do i=1,5
-    call mpi_unpack( rbuf,20,position,temp,1,MPI_INTEGER, &
-         MPI_COMM_WORLD)
-    print *,temp
-  end do
+        position=0
+	do i=1,5
+	  call mpi_unpack( rbuf,20,position,temp,1,MPI_INTEGER, &
+                           MPI_COMM_WORLD)
+          print *,temp
+        end do
+
+        do i=1,5
+          if (rbuf(i) .ne. sbuf(i)) then
+            errcount = errcount + 1
+            print *,"Error for pack/send/unpack"
+            print *,"found ",rbuf(i)," should be ",sbuf(i)
+          end if 
+        end do
+!
+
+
+	call mpi_finalize(ier)
+
+	do i=1,5
+          print *, 'Time=',mpi_wtime()
+          call sleep(1)
+	end do
+
+        if (errcount .gt. 0) then
+          print *,errcount," errors"
+        else
+          print *,"No errors"
+        end if
+
+ 	end
 
-  do i=1,5
-    if (rbuf(i) .ne. sbuf(i)) then
-      errcount = errcount + 1
-      print *,"Error for pack/send/unpack"
-      print *,"found ",rbuf(i)," should be ",sbuf(i)
-    end if
-  end do
-  !
-
-
-  call mpi_finalize(ier)
-
-  do i=1,5
-    print *, 'Time=',mpi_wtime()
-    call sleep(1)
-  end do
-
-  if (errcount .gt. 0) then
-    print *,errcount," errors"
-  else
-    print *,"No errors"
-  end if
-
-end program test

src/externals/mct/mpi-serial/type.c

@@ -843,3 +843,4 @@ int Pprint_typemap(Datatype type)
   return MPI_SUCCESS;
 }
 #endif //TEST_INTERNAL
+