The routine readTileFile
reads a tile file and stores the
relevant data in module variables for later use.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | TFDir | |||
character(len=*), | intent(in) | :: | gridIn | |||
character(len=*), | intent(in) | :: | gridOut | |||
integer, | optional | :: | RC |
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