!!========================================================================   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