glat = chunks(cid)%lat(i)             block_cnt = get_block_coord_cnt_d(glon,glat)            call get_block_coord_d(glon,glat,block_cnt,blockids,bcids)            do jb=1,block_cnt               owner_d = get_block_owner_d(blockids(jb))                if (owner_d .ne. chunks(cid)%owner) then                  local_dp_map = .false.                  endif            enddo         enddo      enddo!! Allocate and initialize data structures for gather/scatter!        allocate ( pgcols(1:ngcols) )      allocate ( gs_col_num(0:npes-1) )      allocate ( gs_col_offset(0:npes) )      pchunkid = 0      endpchunk = 0      curgcol = 0      do p=0,npes-1         gs_col_offset(p) = curgcol + 1         begpchunk = endpchunk + 1         plchunks = 0         gs_col_num(p) = 0         do cid=1,nchunks            if (chunks(cid)%owner == p) then               pchunkid = pchunkid + 1               plchunks = plchunks + 1               chunks(cid)%lchunk = pchunkid + lastblock               do i=1,chunks(cid)%ncols                  curgcol = curgcol + 1                  pgcols(curgcol)%chunk = cid                  pgcols(curgcol)%ccol = i                  gs_col_num(p) = gs_col_num(p) + 1               enddo            endif         enddo         endpchunk = begpchunk + plchunks - 1         if (iam == p) then!! Local chunk index range chosen so that it does not overlap ! {begblock,...,endblock}!             nlchunks = plchunks            begchunk = begpchunk + lastblock            endchunk = endpchunk + lastblock         endif      enddo      gs_col_offset(npes) = curgcol + 1      nlcols = gs_col_num(iam)!      allocate ( lchunks(begchunk:endchunk) )      do cid=1,nchunks         if (chunks(cid)%owner == iam) then            lchunks(chunks(cid)%lchunk) = cid         endif      enddo!   endif!   if (.not. local_dp_map) then!! allocate and initialize data structures for transposes!        allocate ( btofc_blk_num(0:npes-1) )      allocate ( btofc_blk_offset(firstblock:lastblock) )      do jb = firstblock,lastblock         nullify( btofc_blk_offset(jb)%pter )      enddo!      glbcnt = 0      curcnt = 0      curp = 0      do curgcol=1,ngcols         cid = pgcols(curgcol)%chunk         i   = pgcols(curgcol)%ccol         owner_p   = chunks(cid)%owner         do while (curp < owner_p)            btofc_blk_num(curp) = curcnt            curcnt = 0            curp = curp + 1         enddo         glon = chunks(cid)%lon(i)         glat = chunks(cid)%lat(i)         block_cnt = get_block_coord_cnt_d(glon,glat)         call get_block_coord_d(glon,glat,block_cnt,blockids,bcids)         do jb = 1,block_cnt            owner_d = get_block_owner_d(blockids(jb))            if (iam == owner_d) then               if (.not. associated(btofc_blk_offset(blockids(jb))%pter)) then                  blksiz = get_block_col_cnt_d(blockids(jb))                  numlvl = get_block_lvl_cnt_d(blockids(jb),bcids(jb))                  btofc_blk_offset(blockids(jb))%ncols = blksiz                  btofc_blk_offset(blockids(jb))%nlvls = numlvl                  allocate ( btofc_blk_offset(blockids(jb))%pter(blksiz,numlvl) )               endif               do k=1,btofc_blk_offset(blockids(jb))%nlvls                  btofc_blk_offset(blockids(jb))%pter(bcids(jb),k) = glbcnt                  curcnt = curcnt + 1                  glbcnt = glbcnt + 1               enddo            endif         enddo      enddo      btofc_blk_num(curp) = curcnt      block_buf_nrecs = glbcnt!        allocate ( btofc_chk_num(0:npes-1) )      allocate ( btofc_chk_offset(begchunk:endchunk) )      do lchnk=begchunk,endchunk         ncol = chunks(lchunks(lchnk))%ncols         btofc_chk_offset(lchnk)%ncols = ncol         btofc_chk_offset(lchnk)%nlvls = pver+1         allocate ( btofc_chk_offset(lchnk)%pter(ncol,pver+1) )      enddo!      curcnt = 0      glbcnt = 0      do p=0,npes-1         do curgcol=gs_col_offset(iam),gs_col_offset(iam+1)-1            cid  = pgcols(curgcol)%chunk            owner_p  = chunks(cid)%owner            if (iam == owner_p) then               i    = pgcols(curgcol)%ccol               lchnk = chunks(cid)%lchunk               glon   = chunks(cid)%lon(i)               glat   = chunks(cid)%lat(i)               block_cnt = get_block_coord_cnt_d(glon,glat)               call get_block_coord_d(glon,glat,block_cnt,blockids,bcids)               do jb = 1,block_cnt                  owner_d = get_block_owner_d(blockids(jb))                  if (p == owner_d) then                     numlvl = get_block_lvl_cnt_d(blockids(jb),bcids(jb))                     call get_block_levels_d(blockids(jb),bcids(jb),numlvl,levels)                     do k=1,numlvl                        btofc_chk_offset(lchnk)%pter(i,levels(k)+1) = glbcnt                        curcnt = curcnt + 1                        glbcnt = glbcnt + 1                     enddo                  endif               enddo            endif         enddo         btofc_chk_num(p) = curcnt         curcnt = 0      enddo      chunk_buf_nrecs = glbcnt   endif!   physgrid_set = .true.   ! Set flag indicating physics grid is now set!   return   end subroutine phys_grid_init!!========================================================================!   subroutine get_chunk_indices_p(index_beg, index_end)!----------------------------------------------------------------------- ! ! Purpose: Return range of indices for local chunks! ! Method: ! ! Author: Patrick Worley! !-----------------------------------------------------------------------   use precision   implicit none!------------------------------Arguments--------------------------------   integer, intent(out) :: index_beg  ! first index used for local chunks   integer, intent(out) :: index_end  ! last index used for local chunks!-----------------------------------------------------------------------   index_beg = begchunk   index_end = endchunk   return   end subroutine get_chunk_indices_p!!========================================================================!   integer function get_ncols_p(lchunkid)!----------------------------------------------------------------------- ! ! Purpose: Return number of columns in chunk given the local chunk id.! ! Method: ! ! Author: Patrick Worley! !-----------------------------------------------------------------------   use precision   implicit none!------------------------------Arguments--------------------------------   integer, intent(in)  :: lchunkid      ! local chunk id!---------------------------Local workspace-----------------------------   integer              :: chunkid       ! global chunk id!-----------------------------------------------------------------------   chunkid = lchunks(lchunkid)   get_ncols_p = chunks(chunkid)%ncols   return   end function get_ncols_p!!========================================================================!   subroutine get_lat_all_p(lchunkid, latdim, lats)!----------------------------------------------------------------------- ! ! Purpose: Return all global latitude indices for chunk! ! Method: ! ! Author: Patrick Worley! !-----------------------------------------------------------------------   use precision   use ppgrid   implicit none!------------------------------Arguments--------------------------------   integer, intent(in)  :: lchunkid      ! local chunk id   integer, intent(in)  :: latdim        ! declared size of output array   integer, intent(out) :: lats(latdim)  ! array of global latitude indices!---------------------------Local workspace-----------------------------   integer :: i                          ! loop index   integer :: chunkid                    ! global chunk id!-----------------------------------------------------------------------   chunkid = lchunks(lchunkid)   do i=1,chunks(chunkid)%ncols     lats(i) = chunks(chunkid)%lat(i)   enddo   return   end subroutine get_lat_all_p!!========================================================================   subroutine get_lat_vec_p(lchunkid, lth, cols, lats)!----------------------------------------------------------------------- ! ! Purpose: Return global latitude indices 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   integer, intent(out) :: lats(lth)     ! array of global latitude indices!---------------------------Local workspace-----------------------------   integer :: i                          ! loop index   integer :: chunkid                    ! global chunk id!-----------------------------------------------------------------------   chunkid = lchunks(lchunkid)   do i=1,lth     lats(i) = chunks(chunkid)%lat(cols(i))   enddo   return   end subroutine get_lat_vec_p!!========================================================================   integer function get_lat_p(lchunkid, col)!----------------------------------------------------------------------- ! ! Purpose: Return global latitude 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_lat_p = chunks(chunkid)%lat(col)   return   end function get_lat_p!!========================================================================!   subroutine get_lon_all_p(lchunkid, londim, lons)!----------------------------------------------------------------------- ! ! Purpose: Return all global longitude indices for chunk! ! Method: ! ! Author: Patrick Worley! !-----------------------------------------------------------------------   use precision   use ppgrid   implicit none!------------------------------Arguments--------------------------------   integer, intent(in)  :: lchunkid      ! local chunk id   integer, intent(in)  :: londim        ! declared size of output array   integer, intent(out) :: lons(londim)  ! array of global longitude indices!---------------------------Local workspace-----------------------------   integer :: i                          ! loop index   integer :: chunkid                    ! global chunk id!-----------------------------------------------------------------------   chunkid = lchunks(lchunkid)   do i=1,chunks(chunkid)%ncols     lons(i) = chunks(chunkid)%lon(i)   enddo   return   end subroutine get_lon_all_p!!========================================================================   subroutine get_lon_vec_p(lchunkid, lth, cols, lons)!----------------------------------------------------------------------- ! ! Purpose: Return global longitude indices 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   integer, intent(out) :: lons(lth)     ! array of global longitude indices!---------------------------Local workspace-----------------------------   integer :: i                          ! loop index   integer :: chunkid                    ! global chunk id!-----------------------------------------------------------------------   chunkid = lchunks(lchunkid)   do i=1,lth     lons(i) = chunks(chunkid)%lon(cols(i))   enddo   return   end subroutine get_lon_vec_p