TileIO.F90 Source File

#include "MAPL_Generic.h"

module MAPL_TileIOMod
   use ESMF
   use pFIO
   use MAPL_BaseMod
   use MAPL_ExceptionHandling
   use MAPL_CommsMod
   use FIleIOSharedMod, only: MAPL_TileMaskGet

   implicit none

   private

   type tile_buffer
      real, allocatable :: ptr(:)
   end type

   type, public :: MAPL_TileIO
     private
      type(ESMF_FieldBundle) :: bundle
      integer :: read_collection_id
      type(tile_buffer), allocatable :: tile_buffer(:)
      contains
         procedure :: request_data_from_file
         procedure :: process_data_from_file
   end type MAPL_TileIO

   interface MAPL_TileIO
      module procedure new_MAPL_TileIO
   end interface MAPL_TileIO

   contains

      function new_MAPL_TileIO(bundle,read_collection_id) result(TileIO)
         type(MAPL_TileIO) :: TileIO
         type(ESMF_FieldBundle),intent(in) :: bundle
         integer, intent(in) :: read_collection_id

         TileIO%bundle = bundle
         TileIO%read_collection_id = read_collection_id
      end function

      subroutine request_data_from_file(this,filename,timeindex,rc)
         class(MAPL_TileIO), intent(inout) :: this
         character(len=*), intent(in) :: filename
         integer, intent(in) :: timeindex
         integer, intent(out), optional :: rc

         integer :: status
         integer :: num_vars,i,rank
         type(ArrayReference) :: ref
         character(len=ESMF_MAXSTR), allocatable :: names(:)
         type(ESMF_Field) :: field
         type(ESMF_Grid) :: grid
         integer :: counts(3)
         integer, allocatable :: local_start(:), global_start(:), global_count(:)


         call ESMF_FieldBundleGet(this%bundle, fieldCount=num_vars, _RC)
         allocate(this%tile_buffer(num_vars))
         allocate(names(num_vars))
         call ESMF_FieldBundleGet(this%bundle, fieldNameList=names, _RC)
         do i=1,num_vars
            call ESMF_FieldBundleGet(this%bundle,names(i),field=field,_RC)
            call ESMF_FieldGet(field,rank=rank,grid=grid,_RC)
            call MAPL_GridGet(grid,globalCellCountPerDim=counts,_RC)
            if (rank==1) then
               allocate(local_start(2),global_start(2),global_count(2))
               local_start = [1,timeindex]
               global_start = [1,timeindex]
               global_count = [counts(1),1]
               if (mapl_am_I_root()) then
                  allocate(this%tile_buffer(i)%ptr(counts(1)),_STAT)
               else
                  allocate(this%tile_buffer(i)%ptr((0)),_STAT)
               end if
               ref = ArrayReference(this%tile_buffer(i)%ptr)
               call i_clients%collective_prefetch_data(this%read_collection_id, filename, trim(names(i)), ref,  &
                  start=local_start, global_start=global_start, global_count = global_count, _RC)
               deallocate(local_start,global_start,global_count)
            else
               _FAIL("rank >1 tile fields not supported")
            end if
         end do

         _RETURN(_SUCCESS)
      end subroutine

      subroutine process_data_from_file(this,rc)
         class(MAPL_TileIO), intent(inout) :: this
         integer, intent(out), optional :: rc

         integer :: status
         integer :: i,num_vars,rank
         type(ESMF_Field) :: field
         character(len=ESMF_MAXSTR), allocatable :: names(:)
         type(ESMF_Grid) :: grid
         integer, pointer :: mask(:)
         real, pointer :: ptr1d(:)

         call ESMF_FieldBundleGet(this%bundle, fieldCount=num_vars, _RC)
         allocate(names(num_vars))
         call ESMF_FieldBundleGet(this%bundle, fieldNameList=names, _RC)
         do i=1,num_vars
            call ESMF_FieldBundleGet(this%bundle,names(i),field=field,_RC)
            call ESMF_FieldGet(field,rank=rank,grid=grid,_RC)
            call MAPL_TileMaskGet(grid,mask,_RC)
            if (rank==1) then
               call ESMF_FieldGet(field,localDE=0,farrayPtr=ptr1d,_RC)
               call ArrayScatter(ptr1d,this%tile_buffer(i)%ptr,grid,mask=mask,_RC)
               deallocate(this%tile_buffer(i)%ptr)
            else
               _FAIL("rank not supported for tile io")
            end if
         enddo
         deallocate(this%tile_buffer)
         _RETURN(_SUCCESS)
      end subroutine

end module