Remove external mpiio

io_factory.f90

@@ -0,0 +1,37 @@
+module io_factory
+  use mpi_aux
+  use io_handler_base
+  use io_handler_ftn
+#ifdef TROVE_USE_MPI_
+  use io_handler_mpi
+#endif
+  use errors
+  implicit none
+
+  contains
+    subroutine allocateHandler(ioHandler)
+      class(ioHandlerBase), allocatable, intent(out) :: ioHandler
+#ifdef TROVE_USE_MPI_
+      if (blacs_size > 1) then
+        ! Only allocate MPI IO when compiled with MPI *and* 
+        ! running with more than one MPI process
+        allocate(ioHandlerMPI::ioHandler)
+      else
+        allocate(ioHandlerFTN::ioHandler)
+      endif
+#else
+      allocate(ioHandlerFTN::ioHandler)
+#endif
+    end subroutine
+
+    subroutine openFile(ioHandler, filename, err, action, position, status, form, access)
+      class(ioHandlerBase), allocatable, intent(out) :: ioHandler
+      character (len = *), intent(in) :: filename
+      type(ErrorType), intent(inout) :: err
+      character (len = *), intent(in) :: action
+      character (len = *), intent(in), optional :: position, status, form, access
+
+      call allocateHandler(ioHandler)
+      call ioHandler%open(filename, err, action, position, status, form, access)
+    end subroutine
+end module

io_handler_base.f90

@@ -7,16 +7,19 @@ module io_handler_base
   type, abstract :: ioHandlerBase
   contains
     procedure(open), deferred :: open
+    procedure(seek), deferred :: seek
     generic :: write => writeScalar, write1DArray, write2DArray, write2DArrayDistBlacs, write2DArrayDistColumn
     procedure(writeScalar), deferred :: writeScalar
     procedure(write1DArray), deferred :: write1DArray
     procedure(write2DArray), deferred :: write2DArray
     procedure(write2DArrayDistBlacs), deferred :: write2DArrayDistBlacs
     procedure(write2DArrayDistColumn), deferred :: write2DArrayDistColumn
-    generic :: read => readScalar, read1DArray, read2DArray
+    generic :: read => readScalar, read1DArray, read2DArray, read2DArrayDistBlacs, read2DArrayDistColumn
     procedure(readScalar), deferred :: readScalar
     procedure(read1DArray), deferred :: read1DArray
     procedure(read2DArray), deferred :: read2DArray
+    procedure(read2DArrayDistBlacs), deferred :: read2DArrayDistBlacs
+    procedure(read2DArrayDistColumn), deferred :: read2DArrayDistColumn
   end type ioHandlerBase
 
   abstract interface
@@ -74,6 +77,25 @@ subroutine read2DArray(this, object)
       class(ioHandlerBase) :: this
       class(*), dimension(:,:), intent(out) :: object
     end subroutine
+    subroutine read2DArrayDistBlacs(this, object, descr, block_type)
+      import ioHandlerBase
+      import MPI_Datatype
+      class(ioHandlerBase) :: this
+      class(*), dimension(:,:), intent(out) :: object
+      integer, intent(in) :: descr(9) ! Description array outputted from co_block_type_init
+      type(MPI_Datatype), intent(in) :: block_type
+    end subroutine
+    subroutine read2DArrayDistColumn(this, object, dimen)
+      import ioHandlerBase
+      class(ioHandlerBase) :: this
+      class(*), intent(out) :: object(:,:)
+      integer, intent(in) :: dimen ! Dimension of entire distributed array
+    end subroutine
+    subroutine seek(this, offset)
+      import ioHandlerBase
+      class(ioHandlerBase) :: this
+      integer, intent(in) :: offset
+    end subroutine
   end interface
 
   private

io_handler_ftn.f90

@@ -12,6 +12,7 @@ module io_handler_ftn
     integer :: iounit = 0
     integer :: stat = 0
     logical :: isOpen = .false.
+    character (len=20) :: accessVal
   contains
     procedure :: writeScalar => writeScalarFTN
     procedure :: write1DArray => write1DArrayFTN
@@ -21,32 +22,20 @@ module io_handler_ftn
     procedure :: readScalar => readScalarFTN
     procedure :: read1DArray => read1DArrayFTN
     procedure :: read2DArray => read2DArrayFTN
+    procedure :: read2DArrayDistBlacs => read2DArrayDistBlacsFTN
+    procedure :: read2DArrayDistColumn => read2DArrayDistColumnFTN
     procedure :: open
     procedure :: close
+    procedure :: seek
     final :: destroyIoHandlerFTN
   end type ioHandlerFTN
 
-  ! Constructor
-  interface ioHandlerFTN
-    procedure :: newIoHandlerFTN
-  end interface ioHandlerFTN
-
   private
 
   public :: ioHandlerFTN
 
   contains
 
-    type(ioHandlerFTN) function newIoHandlerFTN(fname, err, action, position, status, form, access) result(this)
-      ! writer FTN constructor
-      type(ErrorType), intent(inout) :: err
-      character (len = *), intent(in) :: fname
-      character (len = *), intent(in) :: action
-      character (len = *), intent(in), optional :: position, status, form, access
-
-      call this%open(fname, err, action, position, status, form, access)
-    end function
-
     subroutine destroyIoHandlerFTN(this)
       type(ioHandlerFTN) :: this
       call this%close()
@@ -83,17 +72,21 @@ subroutine open(this, fname, err, action, position, status, form, access)
       end if
 
       if (present(access)) then
-        accessVal = access
+        this%accessVal = access
       else
-        accessVal = 'sequential'
-      end if
+        this%accessVal = 'sequential'
+      endif
 
-      print *, "FTN: Opening ", trim(fname), " with ", \
-        trim(positionVal), " ", trim(statusVal), " ", trim(formVal), " ", trim(accessVal)
+      print *, "FTN: Opening ", trim(fname), " with ", &
+        trim(action), " ", &
+        trim(positionVal), " ", &
+        trim(statusVal), " ", &
+        trim(formVal), " ", &
+        trim(this%accessVal)
 
-      open(newunit=this%iounit, action=action,\
-        form=formVal, position=positionVal, status=statusVal, file=fname,\
-        iostat=this%stat)
+      open(newunit=this%iounit, action=action, &
+        form=formVal, position=positionVal, status=statusVal, & 
+        access=this%accessVal, file=fname, iostat=this%stat)
 
       if (this%stat == 0) then
         this%isOpen = .true.
@@ -110,10 +103,23 @@ subroutine close(this)
       endif
     end subroutine
 
+    subroutine seek(this, offset)
+      class(ioHandlerFTN) :: this
+      INTEGER, PARAMETER :: SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2
+      integer, intent(in) :: offset
+      integer :: total_offset
+
+      if (trim(this%accessVal) == "sequential" .and. offset .ne. 0) then
+        ! Add two bookend offsets
+        total_offset = offset + 2*4
+      endif
+      call fseek(this%iounit, total_offset, SEEK_CUR)
+    end subroutine
+
     subroutine writeScalarFTN(this, object)
       class(ioHandlerFTN) :: this
       class(*), intent(in) :: object
-      print *, "writing scalar object with FTN IO"
+
       select type(object)
       type is (integer)
         write(this%iounit) object
@@ -122,16 +128,16 @@ subroutine writeScalarFTN(this, object)
       type is (complex)
         write(this%iounit) object
       type is (character(len=*))
-        write(this%iounit) object
+        write(this%iounit) trim(object)
       class default
-        print *, "ERROR: Tried to write unsupported type"
+        stop "ioHandlerFTN%writeScalarFTN: Tried to write unsupported type"
       end select
     end subroutine
 
     subroutine write1DArrayFTN(this, object)
       class(ioHandlerFTN) :: this
       class(*), dimension(:), intent(in) :: object
-      print *, "writing 1D array with FTN IO"
+
       select type(object)
       type is (integer)
         write(this%iounit) object
@@ -140,14 +146,14 @@ subroutine write1DArrayFTN(this, object)
       type is (complex)
         write(this%iounit) object
       class default
-        print *, "ERROR: Tried to write unsupported type"
+        stop "ioHandlerFTN%write1DArrayFTN: Tried to write unsupported type"
       end select
     end subroutine
 
     subroutine write2DArrayFTN(this, object)
       class(ioHandlerFTN) :: this
       class(*), dimension(:,:), intent(in) :: object
-      print *, "writing 2D array with FTN IO"
+
       select type(object)
       type is (integer(int32))
         write(this%iounit) object
@@ -162,7 +168,7 @@ subroutine write2DArrayFTN(this, object)
       type is (complex(kind=8))
         write(this%iounit) object
       class default
-        print *, "ERROR: Tried to write unsupported type"
+        stop "ioHandlerFTN%write2DArrayFTN: Tried to write unsupported type"
       end select
     end subroutine
 
@@ -192,48 +198,91 @@ subroutine write2DArrayDistColumnFTN(this, object, mdimen)
     subroutine readScalarFTN(this, object)
       class(ioHandlerFTN) :: this
       class(*), intent(out) :: object
-      print *, "reading object with FTN IO"
+
       select type(object)
-      type is (integer)
+      type is (integer(int32))
         read(this%iounit) object
-      type is (real)
+      type is (integer(int64))
         read(this%iounit) object
-      type is (complex)
+      type is (real(real32))
+        read(this%iounit) object
+      type is (real(real64))
+        read(this%iounit) object
+      type is (complex(kind=4))
+        read(this%iounit) object
+      type is (complex(kind=8))
+        read(this%iounit) object
+      type is (character(len=*))
         read(this%iounit) object
       class default
-        print *, "Unsupported type!"
+        stop "ioHandlerFTN%readScalarFTN: Tried to read unsupported type"
       end select
     end subroutine
 
     subroutine read1DArrayFTN(this, object)
       class(ioHandlerFTN) :: this
       class(*), dimension(:), intent(out) :: object
-      print *, "reading 1D array with FTN IO"
+
       select type(object)
-      type is (integer)
+      type is (integer(int32))
         read(this%iounit) object
-      type is (real)
+      type is (integer(int64))
         read(this%iounit) object
-      type is (complex)
+      type is (real(real32))
+        read(this%iounit) object
+      type is (real(real64))
+        read(this%iounit) object
+      type is (complex(kind=4))
+        read(this%iounit) object
+      type is (complex(kind=8))
         read(this%iounit) object
       class default
-        print *, "Unsupported type!"
+        stop "ioHandlerFTN%read1DArrayFTN: Tried to read unsupported type"
       end select
     end subroutine
 
     subroutine read2DArrayFTN(this, object)
       class(ioHandlerFTN) :: this
       class(*), dimension(:,:), intent(out) :: object
-      print *, "reading 2D array with FTN IO"
+
       select type(object)
-      type is (integer)
+      type is (integer(int32))
         read(this%iounit) object
-      type is (real)
+      type is (integer(int64))
         read(this%iounit) object
-      type is (complex)
+      type is (real(real32))
+        read(this%iounit) object
+      type is (real(real64))
+        read(this%iounit) object
+      type is (complex(kind=4))
+        read(this%iounit) object
+      type is (complex(kind=8))
         read(this%iounit) object
       class default
-        print *, "Unsupported type!"
+        stop "ioHandlerFTN%read2DArrayFTN: Tried to read unsupported type"
       end select
     end subroutine
+
+    subroutine read2DArrayDistBlacsFTN(this, object, descr, block_type)
+      ! Read blacs-distributed arrays
+
+      class(ioHandlerFTN) :: this
+      class(*), dimension(:,:), intent(out) :: object
+      integer, intent(in) :: descr(9) ! Description array outputted from co_block_type_init
+      type(MPI_Datatype), intent(in) :: block_type
+
+      ! Using the fortran io_handler means array isn't distributed, just read normally
+      call this%read2DArray(object)
+    end subroutine
+
+    subroutine read2DArrayDistColumnFTN(this, object, dimen)
+      ! read arrays distributed as columns using co_distr_data
+
+      class(ioHandlerFTN) :: this
+      class(*), dimension(:,:), intent(out) :: object
+      integer, intent(in) :: dimen
+
+      ! Using the fortran io_handler means array isn't distributed, just read normally
+      call this%read2DArray(object)
+    end subroutine
 end module