phys_grid.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

!
!========================================================================

   integer function get_lon_p(lchunkid, col)
!----------------------------------------------------------------------- 
! 
! Purpose: Return global longitude index for chunk column
! 
! Method: 
! 
! Author: Patrick Worley
! 
!-----------------------------------------------------------------------
   use precision
   use ppgrid

   implicit none
!------------------------------Arguments--------------------------------
   integer, intent(in)  :: lchunkid      ! local chunk id
   integer, intent(in)  :: col           ! column index

!---------------------------Local workspace-----------------------------
   integer :: chunkid                    ! global chunk id

!-----------------------------------------------------------------------
   chunkid = lchunks(lchunkid)
   get_lon_p = chunks(chunkid)%lon(col)

   return
   end function get_lon_p
!
!========================================================================
!
   subroutine get_rlat_all_p(lchunkid, rlatdim, rlats)
!----------------------------------------------------------------------- 
! 
! Purpose: Return all latitudes (in radians) for chunk
! 
! Method: 
! 
! Author: Patrick Worley
! 
!-----------------------------------------------------------------------
   use precision
   use ppgrid

   implicit none
!------------------------------Arguments--------------------------------
   integer, intent(in)  :: lchunkid      ! local chunk id
   integer, intent(in)  :: rlatdim        ! declared size of output array

   real(r8), intent(out) :: rlats(rlatdim)! array of latitudes

!---------------------------Local workspace-----------------------------
   integer :: i                           ! loop index
   integer :: chunkid                     ! global chunk id

!-----------------------------------------------------------------------
   chunkid = lchunks(lchunkid)
   do i=1,chunks(chunkid)%ncols
     rlats(i) = clat_p(chunks(chunkid)%lat(i))
   enddo

   return
   end subroutine get_rlat_all_p
!
!========================================================================

   subroutine get_rlat_vec_p(lchunkid, lth, cols, rlats)
!----------------------------------------------------------------------- 
! 
! Purpose: Return latitudes (in radians) for set of chunk columns
! 
! Method: 
! 
! Author: Patrick Worley
! 
!-----------------------------------------------------------------------
   use precision
   use ppgrid

   implicit none
!------------------------------Arguments--------------------------------
   integer, intent(in)  :: lchunkid      ! local chunk id
   integer, intent(in)  :: lth           ! number of column indices
   integer, intent(in)  :: cols(lth)     ! column indices

   real(r8), intent(out) :: rlats(lth)   ! array of latitudes

!---------------------------Local workspace-----------------------------
   integer :: i                          ! loop index
   integer :: chunkid                    ! global chunk id

!-----------------------------------------------------------------------
   chunkid = lchunks(lchunkid)
   do i=1,lth
     rlats(i) = clat_p(chunks(chunkid)%lat(cols(i)))
   enddo

   return
   end subroutine get_rlat_vec_p
!
!========================================================================

   real(r8) function get_rlat_p(lchunkid, col)
!----------------------------------------------------------------------- 
! 
! Purpose: Return latitude (in radians) for chunk column
! 
! Method: 
! 
! Author: Patrick Worley
! 
!-----------------------------------------------------------------------
   use precision
   use ppgrid

   implicit none
!------------------------------Arguments--------------------------------
   integer, intent(in)  :: lchunkid      ! local chunk id
   integer, intent(in)  :: col           ! column index

!---------------------------Local workspace-----------------------------
   integer :: chunkid                    ! global chunk id

!-----------------------------------------------------------------------
   chunkid = lchunks(lchunkid)
   get_rlat_p = clat_p(chunks(chunkid)%lat(col))

   return
   end function get_rlat_p
!
!
!========================================================================
!
   subroutine get_rlon_all_p(lchunkid, rlondim, rlons)
!----------------------------------------------------------------------- 
! 
! Purpose: Return all longitudes (in radians) for chunk
! 
! Method: 
! 
! Author: Patrick Worley
! 
!-----------------------------------------------------------------------
   use precision
   use ppgrid

   implicit none
!------------------------------Arguments--------------------------------
   integer, intent(in)  :: lchunkid      ! local chunk id
   integer, intent(in)  :: rlondim        ! declared size of output array

   real(r8), intent(out) :: rlons(rlondim)! array of longitudes

!---------------------------Local workspace-----------------------------
   integer :: i                           ! loop index
   integer :: chunkid                     ! global chunk id

!-----------------------------------------------------------------------
   chunkid = lchunks(lchunkid)
   do i=1,chunks(chunkid)%ncols
     rlons(i) = clon_p(chunks(chunkid)%lon(i),chunks(chunkid)%lat(i))
   enddo

   return
   end subroutine get_rlon_all_p
!
!========================================================================

   subroutine get_rlon_vec_p(lchunkid, lth, cols, rlons)
!----------------------------------------------------------------------- 
! 
! Purpose: Return longitudes (in radians) for set of chunk columns
! 
! Method: 
! 
! Author: Patrick Worley
! 
!-----------------------------------------------------------------------
   use precision
   use ppgrid

   implicit none
!------------------------------Arguments--------------------------------
   integer, intent(in)  :: lchunkid      ! local chunk id
   integer, intent(in)  :: lth           ! number of column indices
   integer, intent(in)  :: cols(lth)     ! column indices

   real(r8), intent(out) :: rlons(lth)   ! array of longitudes

!---------------------------Local workspace-----------------------------
   integer :: i                          ! loop index
   integer :: chunkid                    ! global chunk id

!-----------------------------------------------------------------------
   chunkid = lchunks(lchunkid)
   do i=1,lth
     rlons(i) = clon_p(chunks(chunkid)%lon(cols(i)), &
                       chunks(chunkid)%lat(cols(i)))
   enddo

   return
   end subroutine get_rlon_vec_p
!
!========================================================================

   real(r8) function get_rlon_p(lchunkid, col)
!----------------------------------------------------------------------- 
! 
! Purpose: Return longitude (in radians) for chunk column
! 
! Method: 
! 
! Author: Patrick Worley
! 
!-----------------------------------------------------------------------
   use precision
   use ppgrid

   implicit none
!------------------------------Arguments--------------------------------
   integer, intent(in)  :: lchunkid      ! local chunk id
   integer, intent(in)  :: col           ! column index

!---------------------------Local workspace-----------------------------
   integer :: chunkid                    ! global chunk id

!-----------------------------------------------------------------------
   chunkid = lchunks(lchunkid)
   get_rlon_p = clon_p(chunks(chunkid)%lon(col),chunks(chunkid)%lat(col))

   return
   end function get_rlon_p
!
!========================================================================

logical function chunk_index (idx)
!----------------------------------------------------------------------- 
! 
! Purpose: Identify whether index is for a latitude or a chunk
! 
! Method: Quick hack, using convention that local chunk indices do not
!         overlap latitude index range
! 
! Author: Pat Worley
! 
!-----------------------------------------------------------------------
   implicit none
!------------------------------Arguments--------------------------------
   integer, intent(in) :: idx              ! latitude or chunk index
!
!-----------------------------------------------------------------------
!
   if ((idx >= begchunk) .and. (idx <= endchunk)) then
      chunk_index = .true.
   else
      chunk_index = .false.
   endif
!
   return
   end function chunk_index

!
!========================================================================

   subroutine get_chunk_coord_p(lth, xylons, xylats, ckcols, ckcids)
!----------------------------------------------------------------------- 
! 
! Purpose: Return local chunk coordinates for corresponding global 
!          (lon,lat) coordinates
! 
! Method: 
! 
! Author: Patrick Worley
! 
!-----------------------------------------------------------------------
   use precision
   use pmgrid, only: iam

   implicit none
!------------------------------Arguments--------------------------------
   integer, intent(in)  :: lth           ! number of coordinates
   integer, intent(in)  :: xylons(lth)   ! longitude indices
   integer, intent(in)  :: xylats(lth)   ! latitude indices

   integer, intent(out) :: ckcols(lth)   ! column indices
   integer, intent(out) :: ckcids(lth)   ! local chunk indices

!---------------------------Local workspace-----------------------------
   integer :: i                          ! loop index

!-----------------------------------------------------------------------
   do i=1,lth
      if (chunks(knuhcs(xylons(i),xylats(i))%chunkid)%owner .eq. iam) then
         ckcols(i) = knuhcs(xylons(i),xylats(i))%col
         ckcids(i) = chunks(knuhcs(xylons(i),xylats(i))%chunkid)%lchunk
      else
         ckcols(i) = -1
         ckcids(i) = -1
      endif
   enddo

   return
   end subroutine get_chunk_coord_p
!
!========================================================================

   subroutine scatter_field_to_chunk(fdim,mdim,ldim, &
                                     nlond,globalfield,localchunks)
!----------------------------------------------------------------------- 
! 
! Purpose: Distribute longitude/latitude field
!          to decomposed chunk data structure
! 
! Method: 
! 
! Author: Patrick Worley
! 
!-----------------------------------------------------------------------
   use precision
   use pmgrid, only: iam, masterproc

   implicit none
!------------------------------Arguments--------------------------------
   integer, intent(in) :: fdim      ! declared length of first dimension
   integer, intent(in) :: mdim      ! declared length of middle dimension
   integer, intent(in) :: ldim      ! declared length of last dimension
   integer, intent(in) :: nlond     ! declared number of longitudes
   real(r8), intent(in) :: globalfield(fdim,nlond,mdim,plat,ldim) 
                                    ! global field

   real(r8), intent(out):: localchunks(fdim,pcols,mdim, &
                                       begchunk:endchunk,ldim) 
                                    ! local chunks

!---------------------------Local workspace-----------------------------
   integer :: f,i,m,l,p                  ! loop indices
   integer :: cid                        ! global chunk id
   integer :: lcid                       ! local chunk id
   integer :: lid                        ! local longitude index

#if ( defined SPMD )
   real(r8) gfield_p(fdim,mdim,ldim,ngcols) 
                                         ! vector to be scattered
   real(r8) lfield_p(fdim,mdim,ldim,nlcols) 
                                         ! local component of scattered
                                         !  vector
   integer :: displs(0:npes-1)           ! scatter displacements
   integer :: sndcnts(0:npes-1)          ! scatter send counts
   integer :: recvcnt                    ! scatter receive count
   integer :: beglcol                    ! beginning index for local columns
                                         !  in global column ordering
#endif

!-----------------------------------------------------------------------
#if ( defined SPMD )
   displs(0) = 0
   sndcnts(0) = fdim*mdim*ldim*gs_col_num(0)
   beglcol = 0
   do p=1,npes-1
     displs(p) = displs(p-1) + sndcnts(p-1)
     sndcnts(p) = fdim*mdim*ldim*gs_col_num(p)
     if (p <= iam) then
        beglcol = beglcol + gs_col_num(p-1)
     endif
   enddo
   recvcnt = fdim*mdim*ldim*nlcols

   if (masterproc) then

! copy field into global (process-ordered) chunked data structure

      do i=1,ngcols
         cid = pgcols(i)%chunk
         lid = pgcols(i)%ccol
         do l=1,ldim
            do m=1,mdim
               do f=1,fdim
                  gfield_p(f,m,l,i) = &
                     globalfield(f,chunks(cid)%lon(lid), m, &
                                 chunks(cid)%lat(lid),l)
               end do
            end do