subroutine readTileFileNC_file(fName, RC)
character(len=*), intent(in) :: fName
integer, optional :: rc
integer :: fID
Real(Kind=sp),Allocatable :: RTemp(:)
Integer,Allocatable :: ITemp(:)
Integer,Allocatable :: IITemp(:), JJTemp(:)
Integer :: I, nGrids, gridInIdx, iX, iY, iG
Integer :: iGrid, iFace
Integer :: nDimIn, nDimOut
Integer :: nX(2), nY(2)
! Expected grid sizes
!Integer :: resIn(2), resOut(2)
! Grid sizes on file
integer :: resInFile(2), resOutFile(2)
! Open NetCDF file
RC = NF90_Open(path=fName,mode=NF90_NOWRITE,ncid=fID)
Call Assert(RC,'readTileFileNC','Open tile file')
! How many weights are there?
RC = NF90_INQ_DIMID(ncid=fID, name='n_s', dimid=I)
If (RC.eq.0) Then
RC = NF90_INQUIRE_DIMENSION(ncid=fID, dimid=I, len=nWeight)
End If
Call Assert(RC,'readTileFileNC','Get weight count',fID)
! Allocate the arrays
Allocate(II_In(nWeight))
Allocate(JJ_In(nWeight))
Allocate(II_Out(nWeight))
Allocate(JJ_Out(nWeight))
Allocate(W(nWeight))
! Each Tempest tile file connects two grids
nGrids = 2
! Determine the input and output dimensions
RC = NF90_INQ_DIMID(ncid=fID, name='src_grid_rank', dimid=I)
RC = NF90_INQUIRE_DIMENSION(ncid=fID, dimid=I, len=nDimIn)
Allocate(ITemp(nDimIn))
RC = NF90_INQ_VARID(ncid=fID, name='src_grid_dims', varid=I)
RC = NF90_GET_VAR(ncid=fID, varid=I, values=ITemp)
resInFile(1:nDimIn) = ITemp(1:nDimIn)
Deallocate(ITemp)
If (nDimIn == 1) Then
! Cubed-sphere grid
I = resInFile(1)
resInFile(1) = Int(sqrt(real(I/6)))
resInFile(2) = resInFile(1) * 6
End If
RC = NF90_INQ_DIMID(ncid=fID, name='dst_grid_rank', dimid=I)
RC = NF90_INQUIRE_DIMENSION(ncid=fID, dimid=I, len=nDimOut)
Allocate(ITemp(nDimOut))
RC = NF90_INQ_VARID(ncid=fID, name='dst_grid_dims', varid=I)
RC = NF90_GET_VAR(ncid=fID, varid=I, values=ITemp)
resOutFile(1:nDimOut) = ITemp(1:nDimOut)
Deallocate(ITemp)
If (nDimOut == 1) Then
! Cubed-sphere grid
I = resOutFile(1)
resOutFile(1) = Int(sqrt(real(I/6)))
resOutFile(2) = resOutFile(1) * 6
End If
!$$ ! Get the expected grid sizes
!$$ Call parseGridName(gridIn, resIn(1), resIn(2))
!$$ Call parseGridName(gridOut, resOut(1), resOut(2))
!$$
! Assign nX and nY to match the format used for binary tile file
nX(1) = resInFile(1)
nY(1) = resInFile(2)
nX(2) = resOutFile(1)
nY(2) = resOutFile(2)
!$$ If (all(resIn.eq.resInFile).and.all(resOut.eq.resOutFile)) Then
!$$ ! Matched, and the direction matches
gridInIdx = 1
!$$ Else If (all(resIn.eq.resOutFile).and.all(resOut.eq.resInFile)) Then
!$$ ! Matched, but for reverse transform
!$$ gridInIdx = 2
!$$ I = nX(2)
!$$ nX(2) = nX(1)
!$$ nX(1) = I
!$$
!$$ I = nY(2)
!$$ nY(2) = nY(1)
!$$ nY(1) = I
!$$ Else
!$$ RC = NF90_CLOSE(ncid=fID)
!$$ RC = -2
!$$ Return
!$$ End If
! Allocate temporary arrays
Allocate(ITemp(nWeight))
Allocate(IITemp(nWeight))
Allocate(JJTemp(nWeight))
Allocate(RTemp(nWeight))
! Read data for grid 1
! X-dim and Y-dim indices
RC = NF90_INQ_VARID(ncid=fID, name='col', varid=I)
RC = NF90_GET_VAR(ncid=fID, varid=I, values=ITemp)
iG = gridInIdx
Do I=1,nWeight
! Exploit integer division
iY = 1 + ((ITemp(I)-1)/nX(iG))
iX = ITemp(I) - ((iY-1)*nX(iG))
IITemp(I) = iX
JJTemp(I) = iY
End Do
If (gridInIdx == 1) Then
II_In = IITemp
JJ_In = JJTemp
Else
II_Out = IITemp
JJ_Out = JJTemp
End If
! Read data for grid 2
! X-dim and Y-dim indices
RC = NF90_INQ_VARID(ncid=fID, name='row', varid=I)
RC = NF90_GET_VAR(ncid=fID, varid=I, values=ITemp)
iG = 2 - (gridInIdx - 1)
Do I=1,nWeight
! Exploit integer division
iY = 1 + ((ITemp(I)-1)/nX(iG))
iX = ITemp(I) - ((iY-1)*nX(iG))
IITemp(I) = iX
JJTemp(I) = iY
End Do
If (gridInIdx == 1) Then
II_Out = IITemp
JJ_Out = JJTemp
Else
II_In = IITemp
JJ_In = JJTemp
End If
! Weights
RC = NF90_INQ_VARID(ncid=fID, name='S', varid=I)
RC = NF90_GET_VAR(ncid=fID, varid=I, values=RTemp)
W = RTemp
! Close the tile file
RC = NF90_CLOSE(ncid=fID)
! Remap the cube faces
Do iGrid = 1, nGrids
If (nY(iGrid)==(6*nX(iGrid))) Then
! Assume this is a CS resolution
If (iGrid==1) Then
IITemp = II_In
JJTemp = JJ_In
Else
IITemp = II_Out
JJTemp = JJ_Out
End If
! Re-order faces to match GMAO conventions
Call swapCS(IITemp,JJTemp,nX(iGrid),nY(iGrid),nWeight)
! Flip face 6 in both II and JJ
Call flipCS(IITemp,JJTemp,nX(iGrid),nY(iGrid),nWeight,6,0)
! Transpose faces 3-5 and flip their II indices
Do iFace=3,5
Call transposeCS(IITemp,JJTemp,nX(iGrid),nY(iGrid),nWeight,iFace)
Call flipCS(IITemp,JJTemp,nX(iGrid),nY(iGrid),nWeight,iFace,1)
End Do
! Reassign
If (iGrid==1) Then
II_In = IITemp
JJ_In = JJTemp
Else
II_Out = IITemp
JJ_Out = JJTemp
End If
EndIf
EndDo
#undef CSREGRID_DEBUG
#if defined ( CSREGRID_DEBUG )
Write(6,'(a,I12)') 'Writing out data. Count: ',nWeight
Do I=1,nWeight
Write(6,'(I12,4(x,I12),x,E16.5E4)') I,II_In(I),JJ_In(I),&
II_Out(I), JJ_Out(I), W(I)
End Do
#endif
! Allocate the counting variable
! nX and nY already swapped
Allocate(outSum(nX(2),nY(2)))
! Deallocate temporary arrays
Deallocate(ITemp)
Deallocate(IITemp)
Deallocate(JJTemp)
Deallocate(RTemp)
RC = 0
! Error check
If ((MinVal(II_In)<1).or.(MinVal(II_Out)<1).or.&
(MinVal(JJ_In)<1).or.(MinVal(JJ_Out)<1)) RC = -5
If ((MaxVal(II_In) >nX(1)).or.&
(MaxVal(II_Out)>nX(2)).or.&
(MaxVal(JJ_In) >nY(1)).or.&
(MaxVal(JJ_Out)>nY(2))) RC = -15
end subroutine readTileFileNC_file