create_cubed_sphere_grid Subroutine

public subroutine create_cubed_sphere_grid(this, rc)

Type Bound

RegridSupport

Arguments

Type IntentOptional Attributes Name
class(RegridSupport), intent(inout) :: this
integer, intent(out), optional :: rc

Calls

proc~~create_cubed_sphere_grid~~CallsGraph proc~create_cubed_sphere_grid RegridSupport%create_cubed_sphere_grid ESMF_DistGridGet ESMF_DistGridGet proc~create_cubed_sphere_grid->ESMF_DistGridGet ESMF_GridAddItem ESMF_GridAddItem proc~create_cubed_sphere_grid->ESMF_GridAddItem ESMF_GridCreateCubedSphere ESMF_GridCreateCubedSphere proc~create_cubed_sphere_grid->ESMF_GridCreateCubedSphere ESMF_GridGet ESMF_GridGet proc~create_cubed_sphere_grid->ESMF_GridGet none~get_dimension FileMetadata%get_dimension proc~create_cubed_sphere_grid->none~get_dimension proc~mapl_distgridget MAPL_DistGridGet proc~create_cubed_sphere_grid->proc~mapl_distgridget proc~mapl_return MAPL_Return proc~create_cubed_sphere_grid->proc~mapl_return proc~mapl_verify MAPL_Verify proc~create_cubed_sphere_grid->proc~mapl_verify none~get_dimension->proc~mapl_return at at none~get_dimension->at find find none~get_dimension->find proc~mapl_distgridget->ESMF_DistGridGet proc~mapl_distgridget->proc~mapl_verify 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

Called by

proc~~create_cubed_sphere_grid~~CalledByGraph proc~create_cubed_sphere_grid RegridSupport%create_cubed_sphere_grid proc~create_esmf_grids RegridSupport%create_esmf_grids proc~create_esmf_grids->proc~create_cubed_sphere_grid program~main~2 main program~main~2->proc~create_esmf_grids

Source Code

   subroutine create_cubed_sphere_grid(this, rc)
      class (RegridSupport), intent(inout) :: this
      integer, optional, intent(out) :: rc
      type (ESMF_DistGrid):: distgrid

      integer :: deToTileMap(0:pet_count-1)
      integer :: minIndex(2,0:pet_count-1), maxIndex(2,0:pet_count-1)
      integer :: ijms(2,6),NX,NY,i,lcnts(2)
      integer :: nPetPerTile
      integer :: status

      this%Xdim = this%cfio_cubed_sphere%get_dimension('Xdim')
      this%LM = this%cfio_cubed_sphere%get_dimension('lev',rc=status)
      ! ignore status
      if (status /= pFIO_SUCCESS) then
        this%LM = 1
        status = pFIO_SUCCESS
      end if

      nPetPerTile = pet_count/n_tiles
      nx = nint(sqrt(real(nPetPerTile*this%Xdim)/this%Xdim))
      nx = max(nx,1)
      do while( mod(nPetPerTile,nx).NE.0)
         nx = nx - 1
      enddo
      ny=nPetPerTile/nx
      ijms(1,1)=NX
      ijms(2,1)=NY
      do i=2,6
         ijms(:,i)=ijms(:,1)
      enddo

      this%grid_cubed_sphere = ESMF_GridCreateCubedSphere(this%Xdim, regDecompPTile=ijms, rc=status)
      _VERIFY(status)

      call ESMF_GridGet(this%grid_cubed_sphere, distgrid=distgrid,rc=status)
      _VERIFY(status)
      call ESMF_DistGridGet(distgrid, deToTileMap=deToTileMap, rc=status)
      _VERIFY(status)
      call MAPL_DistGridGet(distgrid, MaxIndex=maxIndex, MinIndex=minIndex, rc=status)
      _VERIFY(status)
      this%my_tile = deToTileMap(local_pet)

      call ESMF_GridGet(this%grid_cubed_sphere,localDE=0,staggerloc=ESMF_STAGGERLOC_CENTER, &
           exclusiveCount=lcnts,rc=status)
      _VERIFY(status)
      call ESMF_GridAddItem(this%grid_cubed_sphere,itemflag=ESMF_GRIDITEM_MASK,staggerloc=ESMF_STAGGERLOC_CENTER, &
           & itemTypeKind=ESMF_TYPEKIND_I4, rc=status)
      _VERIFY(status)
      this%nx_loc=lcnts(1)
      this%ny_loc=lcnts(2)
      select case (this%my_tile)
         case(1)
            this%x_1=minIndex(1,local_pet)
            this%x_n=maxIndex(1,local_pet)
            this%y_1=minIndex(2,local_pet)
            this%y_n=maxIndex(2,local_pet)
         case(2)
            this%x_1=minIndex(1,local_pet) - this%Xdim
            this%x_n=maxIndex(1,local_pet) - this%Xdim
            this%y_1=minIndex(2,local_pet)
            this%y_n=maxIndex(2,local_pet)
         case(3)
            this%x_1=minIndex(1,local_pet) - this%Xdim
            this%x_n=maxIndex(1,local_pet) - this%Xdim
            this%y_1=minIndex(2,local_pet) - this%Xdim
            this%y_n=maxIndex(2,local_pet) - this%Xdim
         case(4)
            this%x_1=minIndex(1,local_pet) - 2*this%Xdim
            this%x_n=maxIndex(1,local_pet) - 2*this%Xdim
            this%y_1=minIndex(2,local_pet) - this%Xdim
            this%y_n=maxIndex(2,local_pet) - this%Xdim
         case(5)
            this%x_1=minIndex(1,local_pet) - 2*this%Xdim
            this%x_n=maxIndex(1,local_pet) - 2*this%Xdim
            this%y_1=minIndex(2,local_pet) - 2*this%Xdim
            this%y_n=maxIndex(2,local_pet) - 2*this%Xdim
         case(6)
            this%x_1=minIndex(1,local_pet) - 3*this%Xdim
            this%x_n=maxIndex(1,local_pet) - 3*this%Xdim
            this%y_1=minIndex(2,local_pet) - 2*this%Xdim
            this%y_n=maxIndex(2,local_pet) - 2*this%Xdim
      end select

      _RETURN(_SUCCESS)
   end subroutine create_cubed_sphere_grid