readTileFileNC_file Subroutine

public subroutine readTileFileNC_file(fName, rc)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: fName
integer, optional :: rc

Calls

proc~~readtilefilenc_file~~CallsGraph proc~readtilefilenc_file readTileFileNC_file nf90_close nf90_close proc~readtilefilenc_file->nf90_close nf90_get_var nf90_get_var proc~readtilefilenc_file->nf90_get_var nf90_inq_dimid nf90_inq_dimid proc~readtilefilenc_file->nf90_inq_dimid nf90_inq_varid nf90_inq_varid proc~readtilefilenc_file->nf90_inq_varid nf90_inquire_dimension nf90_inquire_dimension proc~readtilefilenc_file->nf90_inquire_dimension nf90_open nf90_open proc~readtilefilenc_file->nf90_open proc~assert Assert proc~readtilefilenc_file->proc~assert proc~assert->nf90_close proc~cleanup Cleanup proc~assert->proc~cleanup proc~cleanup->nf90_close

Called by

proc~~readtilefilenc_file~~CalledByGraph proc~readtilefilenc_file readTileFileNC_file none~initialize_subclass~2 TilingRegridder%initialize_subclass none~initialize_subclass~2->proc~readtilefilenc_file proc~readtilefilenc readTileFileNC proc~readtilefilenc->proc~readtilefilenc_file none~initialize~18 AbstractRegridder%initialize none~initialize~18->none~initialize_subclass~2 none~initialize_base AbstractRegridder%initialize_base none~initialize~18->none~initialize_base none~initialize_base->none~initialize~18 none~make_regridder_from_grids RegridderManager%make_regridder_from_grids none~make_regridder_from_grids->none~initialize~18 none~make_regridder~2 RegridderManager%make_regridder none~make_regridder~2->none~make_regridder_from_grids

Source Code

      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