readTileFile Subroutine

public subroutine readTileFile(TFDir, gridIn, gridOut, RC)

The routine readTileFile reads a tile file and stores the relevant data in module variables for later use.

History

  • 09 Jan 2016 - S. D. Eastham - Initial version

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: TFDir
character(len=*), intent(in) :: gridIn
character(len=*), intent(in) :: gridOut
integer, optional :: RC

Calls

proc~~readtilefile~~CallsGraph proc~readtilefile readTileFile proc~assert Assert proc~readtilefile->proc~assert proc~getlun GetLUN proc~readtilefile->proc~getlun nf90_close nf90_close proc~assert->nf90_close proc~cleanup Cleanup proc~assert->proc~cleanup proc~cleanup->nf90_close

Source Code

      Subroutine readTileFile(TFDir,gridIn,gridOut,RC)
!
! !USES:
!
!      Use Precision_Mod, Only: f4

!
! !INPUT PARAMETERS:
!
      Character(Len=*), Intent(In)         :: TFDir
      Character(Len=*), Intent(In)         :: gridIn
      Character(Len=*), Intent(In)         :: gridOut
      Integer, Optional                    :: RC
!
! !OUTPUT PARAMETERS:
!
      !Real(kind=sp), Intent(Out) :: TestOut
!
!-----------------------------------------------------------------------
!
! !LOCAL VARIABLES:
!
      Character(Len=255)        :: fName, errMsg
      Logical                   :: Found
      Integer                   :: fID, status
      Real(Kind=sp),Allocatable :: RTemp(:)
      Integer,Allocatable       :: ITemp(:)
      Integer                   :: I, nGrids, gridInIdx
      Integer                   :: nX(2), nY(2)
      Character(Len=128)        :: STemp
      Character(Len=128)        :: gridNameTF(2)

      !=================================================================
      ! readTileFile starts here!
      !=================================================================

      ! Assemble the full tile file name
      Write(fName,'(a,a,a,a)') Trim(gridIn),'_',Trim(gridOut),'.bin'
      fName = Trim(TFDir) // '/' // Trim(fName)

      Inquire(File=fName,Exist=Found)
      If (.not.Found) Then
         ! Try the reverse name
         Write(fName,'(a,a,a,a)') Trim(gridOut),'_',Trim(gridIn),'.bin'
         fName = Trim(TFDir) // '/' // Trim(fName)

         Inquire(File=fName,Exist=Found)
         If (.not.Found) Then
            Write(6,'(a,a)') ' --- Could not find binary tile file ',Trim(fName)
            RC = -1
            Return
         End If
      End If

      ! Tile file variables
      Call GetLUN(fID,RC=RC)
      Call Assert(RC,'readTileFile','GetLUN failed')

      ! NOTE: Tile files are little-endian
      Open(File=Trim(fName),Unit=fID,IOStat=status,&
               FORM='UNFORMATTED',STATUS='OLD')
      If (status/=0) Then
         Write(errMsg,'(a,a,a,I8)') 'Failed to open ',Trim(fName),&
            '. ID: ', status
         Call Assert(status,'readTileFile',errMsg)
      End If

      ! Read in the number of weights
      Read(fID) nWeight

      ! Allocate the arrays
      Allocate(II_In(nWeight))
      Allocate(JJ_In(nWeight))
      Allocate(II_Out(nWeight))
      Allocate(JJ_Out(nWeight))
      Allocate(W(nWeight))

      ! Also allocate temporary arrays
      Allocate(ITemp(nWeight))
      Allocate(RTemp(nWeight))

      Read(fID) nGrids
      If (nGrids.ne.2) Then
         Close(Unit=fID)
         Call Assert(-1,'readTileFile','Bad grid count')
      End If

      Do I=1,nGrids
         Read(fID) STemp
         Read(fID) nX(I)
         Read(fID) nY(I)
         gridNameTF(I) = Trim(STemp)
      End Do

      Found = .False.
      Do I=1,nGrids
         If (Trim(gridNameTF(I)) == Trim(gridIn)) Then
            Found = .True.
            Exit
         End If
      End Do

      If (.not.Found) Then
         Close(Unit=fID)
         Call Assert(-1,'readTileFile','Input grid name mismatch')
      End If

      gridInIdx = I
      If (.not.Found) Then
         Close(Unit=fID)
         Call Assert(-1,'readTileFile','Input grid name mismatch')
      End If

      ! Must arrange so that grid 1 is the input grid
      If (gridInIdx .ne. 1) Then
         STemp = gridNameTF(2)
         gridNameTF(2) = gridNameTF(1)
         gridNameTF(1) = STemp

         I = nX(2)
         nX(2) = nX(1)
         nX(1) = I

         I = nY(2)
         nY(2) = nY(1)
         nY(1) = I
      End If

      Found = (gridNameTF(1) == gridIn)
      If (.not.Found) Then
         Close(Unit=fID)
         Call Assert(-1,'readTileFile','Rearrangement failed')
      End If

      Found = (gridNameTF(2) == gridOut)
      If (.not.Found) Then
         Close(Unit=fID)
         Call Assert(-1,'readTileFile','Output grid name mismatch')
      End If

      ! Skip 3 fields
      Read(fID)
      Read(fID)
      Read(fID)

      ! Read data for grid 1
      ! X-dim indices
      Read(fID) RTemp
      ITemp = NINT(RTemp)
      If (gridInIdx == 1) Then
         II_In = ITemp
      Else
         II_Out = ITemp
      End If

      ! Y-dim indices
      Read(fID) RTemp
      ITemp = NINT(RTemp)
      If (gridInIdx == 1) Then
         JJ_In = ITemp
      Else
         JJ_Out = ITemp
      End If

      Read(fID) RTemp
      ! Doesn't actually matter whether we use W_In or W_Out
      W = RTemp

      ! Now repeat for grid 2
      ! X-dim indices
      Read(fID) RTemp
      ITemp = NINT(RTemp)
      If (gridInIdx == 2) Then
         II_In = ITemp
      Else
         II_Out = ITemp
      End If

      ! Y-dim indices (in)
      Read(fID) RTemp
      ITemp = NINT(RTemp)
      If (gridInIdx == 2) Then
         JJ_In = ITemp
      Else
         JJ_Out = ITemp
      End If

      !Read(fID) RTemp
      !W = RTemp

      ! Close the tile file
      Close(Unit=fID)

      ! Allocate the counting variable
      ! nX and nY already swapped
      Allocate(outSum(nX(2),nY(2)))

      ! Deallocate temporary arrays
      Deallocate(ITemp)
      Deallocate(RTemp)

      End Subroutine readTileFile