MAPL_ReadTilingASCII Subroutine

public subroutine MAPL_ReadTilingASCII(LAYOUT, FileName, GridName, NT, IM, JM, n_Grids, N_PfafCat, AVR, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_DELayout), intent(in) :: LAYOUT
character(len=*), intent(in) :: FileName
character(len=*), intent(out) :: GridName(:)
integer, intent(out) :: NT
integer, intent(out) :: IM(:)
integer, intent(out) :: JM(:)
integer, intent(out) :: n_Grids
integer, intent(out) :: N_PfafCat
real, intent(out), pointer :: AVR(:,:)
integer, intent(out), optional :: rc

Calls

proc~~mapl_readtilingascii~~CallsGraph proc~mapl_readtilingascii MAPL_ReadTilingASCII interface~read_parallel READ_PARALLEL proc~mapl_readtilingascii->interface~read_parallel proc~free_file FREE_FILE proc~mapl_readtilingascii->proc~free_file proc~getfile GETFILE proc~mapl_readtilingascii->proc~getfile proc~mapl_return MAPL_Return proc~mapl_readtilingascii->proc~mapl_return proc~mapl_verify MAPL_Verify proc~mapl_readtilingascii->proc~mapl_verify proc~free_file->proc~mapl_return interface~mapl_assert MAPL_Assert proc~free_file->interface~mapl_assert proc~getfile->proc~mapl_return proc~getfile->proc~mapl_verify interface~mapl_am_i_root MAPL_Am_I_Root proc~getfile->interface~mapl_am_i_root at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception proc~mapl_verify->proc~mapl_throw_exception

Source Code

   subroutine MAPL_ReadTilingASCII(layout, FileName, GridName, NT, im, jm, n_Grids, N_PfafCat, AVR,rc)
      type(ESMF_DELayout), intent(IN)  :: LAYOUT
      character(*),        intent(IN)  :: FileName
      character(*),        intent(out) :: GridName(:)
      integer,             intent(out) :: NT
      integer,             intent(out) :: IM(:), JM(:)
      integer,             intent(out) :: n_Grids
      integer,             intent(out) :: N_PfafCat
      real,  pointer,      intent(out) :: AVR(:,:)      ! used by GEOSgcm
      integer, optional,   intent(out) :: rc

      integer :: unit, status, hdr(2), N
      real, pointer :: AVR_Transpose(:,:)

      UNIT = GETFILE(FILENAME, form='FORMATTED', RC=status)
      _VERIFY(STATUS)

! Total number of tiles in exchange grid
!---------------------------------------

      call READ_PARALLEL(layout, hdr, UNIT=UNIT, rc=status)
       _VERIFY(STATUS)
       NT        = hdr(1)
       N_PfafCat = hdr(2)
       
      call READ_PARALLEL(layout, N_GRIDS, unit=UNIT, rc=status)
      _VERIFY(STATUS)

      do N = 1, N_GRIDS
         call READ_PARALLEL(layout, GridName(N), unit=UNIT, rc=status)
         _VERIFY(STATUS)
         call READ_PARALLEL(layout, IM(N), unit=UNIT, rc=status)
         _VERIFY(STATUS)
         call READ_PARALLEL(layout, JM(N), unit=UNIT, rc=status)
         _VERIFY(STATUS)
      enddo

      if(index(GridNAME(1),'EASE') /=0 ) then
          allocate(AVR(NT,9), STAT=STATUS) ! 9 columns for EASE grid
          _VERIFY(STATUS)
          allocate(AVR_transpose(9,NT))
      else
         allocate(AVR(NT,NumGlobalVars+NumLocalVars*N_GRIDS), STAT=STATUS)
         _VERIFY(STATUS)
         allocate(AVR_transpose(NumGlobalVars+NumLocalVars*N_GRIDS,NT), STAT=STATUS)
         _VERIFY(STATUS)
      endif

      call READ_PARALLEL(layout, AVR_transpose(:,:), unit=UNIT, rc=status)
      AVR = transpose(AVR_transpose)
      deallocate(AVR_transpose)
      call FREE_FILE(UNIT)

      _RETURN(ESMF_SUCCESS)

   end subroutine MAPL_ReadTilingASCII