module comm
    use const
    use var
    use mpi
implicit real*8 (a-h,o-z)
    common/mpicomm/m_cart,m_comm_2d,m_comm_lon,m_comm_lat,myid,mylon,mylat,m_n,m_e, &
    m_s,m_w,m_vlon,m_vlat,m_v8lon,m_v8lat,js,jf,ierr, &
    npx(14),npy(14),istat(mpi_status_size)
    common/mpi_vtype/m_vlon2d,m_vlat2d,m_vlon3d,m_vlat3d,m_v8lonx2d,m_v8latx2d,m_evlon2d,m_evlat2d

contains


subroutine init_comm
    ! mpi initialization
    call mpi_init(ierr)
    call mpi_comm_size(mpi_comm_world, nproc, ierr)
    call mpi_comm_rank(mpi_comm_world, myid, ierr)

    if (nproc .ne. ng0) then
	print*,'ng0=', ng0,' is not equal to nproc=',nproc
	call mpi_finalize(ierr)
	stop
    endif

end subroutine


subroutine mpi_grid2d_gen
    logical peri,rdim1,rdim2
    dimension ndim(2),mycrd(2),peri(2),rdim1(2),rdim2(2)

    ndim(1)=ngx0
    ndim(2)=ngy0
    peri(1)=.true.
    peri(2)=.false.
    rdim1(1)=.true.
    rdim1(2)=.false.
    rdim2(1)=.false.
    rdim2(2)=.true.
    call mpi_cart_create(mpi_comm_world,2,ndim,peri,.true.,m_comm_2d,ierr)
    call mpi_cart_shift(m_comm_2d,0,1,m_w,m_e,ierr)
    call mpi_cart_shift(m_comm_2d,1,1,m_s,m_n,ierr)
    call mpi_cart_sub(m_comm_2d,rdim1,m_comm_lon,ierr)
    call mpi_cart_sub(m_comm_2d,rdim2,m_comm_lat,ierr)
    call mpi_comm_rank(m_comm_lon,mylon,ierr)
    call mpi_comm_rank(m_comm_lat,mylat,ierr)

    write(grd,'(i3.3,a1,i3.3)')mylon,'_',mylat
end subroutine

!-----------------------------------------
subroutine mpi_grid_gen
    parameter(nbg0=nb0*ngy0,nbg1=nbg0-1,i01=i0+1,ig0=i2*ngx0+2,ig1=ig0-1,ig2=ig0-2,ibir=ig2/ngy0,j01=j0+1)

    dimension ndim(3),mycrd(3),mycor(3)
    logical peri(3),rdim1(3),rdim2(3)
    data ndim / 1,ngy0,ngx0/
    data peri / .false., .false., .true./
    data rdim1 / .false., .false., .true./
    data rdim2 / .false., .true., .false./

    integer(kind=mpi_offset_kind) nn,ns_kji,nc_kji,ns_tji,nc_tji,ns_ji,nc_ji,ns_1,nc_1

    common/pnetcdf/nn(6),ns_kji(3),nc_kji(3),ns_tji(3),nc_tji(3),ns_ji(2),nc_ji(2),ns_1,nc_1,nf_kji(3)

    integer(kind=mpi_offset_kind) ns_kji2,nc_kji2,ns_tji2,nc_tji2,ns_ji2,nc_ji2,nf_kji2

    common/pnetcdf2/ns_kji2(3),nc_kji2(3),ns_tji2(3),nc_tji2(3),ns_ji2(2),nc_ji2(2),nf_kji2(3)


    call mpi_dims_create(ng0,3,ndim,ierr)
    call mpi_cart_create(mpi_comm_world,3,ndim,peri,.true.,m_cart,ierr)
    call mpi_cart_shift(m_cart,2,1,m_w,m_e,ierr)
    call mpi_cart_shift(m_cart,1,1,m_s,m_n,ierr)
    call mpi_cart_sub(m_cart,rdim1,m_comm_lon,ierr)
    call mpi_cart_sub(m_cart,rdim2,m_comm_lat,ierr)
    call mpi_comm_rank(m_comm_lon,mylon,ierr)
    call mpi_comm_rank(m_comm_lat,mylat,ierr)
    call mpi_cart_coords (m_cart, myid, 3, mycor, ierr)

    write(grd,'(i3.3,a1,i3.3)')mylon,'_',mylat
    
    ! cartisean remark
    ! -------------------------------
    ! | 2 | 5 | 8 | 11 |
    ! | (0,2) | (1,2) | (2,2) | (3,2) |
    ! |-------|-------|-------|-------|
    ! | 1 | 4 | 7 | 10 |
    ! | (0,1) | (1,1) | (2,1) | (3,1) |
    ! |-------|-------|-------|-------|
    ! | 0 | 3 | 6 | 9 |
    ! | (0,0) | (1,0) | (2,0) | (3,0) |
    ! -------------------------------
    
    call mpi_type_vector(j0,1,i0,mpi_real8,m_vlon2d,ierr)
    call mpi_type_vector(1,i0,j0,mpi_real8,m_vlat2d,ierr)
    call mpi_type_commit(m_vlon2d,ierr)
    call mpi_type_commit(m_vlat2d,ierr)
    call mpi_type_vector(k1*j0,1,i0,mpi_real8,m_vlon3d,ierr)
    call mpi_type_vector(k1,i0,i0*j0,mpi_real8,m_vlat3d,ierr)
    call mpi_type_commit(m_vlon3d,ierr)
    call mpi_type_commit(m_vlat3d,ierr)
    call mpi_type_vector(j0,1,i0,mpi_real8,m_v8lonx2d,ierr)
    call mpi_type_vector(1,i0,i0*j0,mpi_real8,m_v8latx2d,ierr)
    call mpi_type_commit(m_v8lonx2d,ierr)
    call mpi_type_commit(m_v8latx2d,ierr)
    call mpi_type_vector(j0,1,i0+1,mpi_real8,m_evlon2d,ierr)
    call mpi_type_vector(1,i0,i0*(j0+1),mpi_real8,m_evlat2d,ierr)
    call mpi_type_commit(m_evlon2d,ierr)
    call mpi_type_commit(m_evlat2d,ierr)


    ! write(grd,'(i3.3,a1,i3.3)')mylon,'_',mylat
    call mpi_type_vector(k1*j0,1,i0,mpi_real8,m_vlon,ierr)
    call mpi_type_vector(k1,i0,i0*j0,mpi_real8,m_vlat,ierr)
    call mpi_type_commit(m_vlon,ierr)
    call mpi_type_commit(m_vlat,ierr)
    call mpi_type_vector(j0,1,i0,mpi_real8,m_v8lon,ierr)
    call mpi_type_vector(1,i0,i0*j0,mpi_real8,m_v8lat,ierr)
    call mpi_type_commit(m_v8lon,ierr)
    call mpi_type_commit(m_v8lat,ierr)


    do i=1,14
	npx(i)=(i-1)*j0*k1+1
	npy(i)=(i-1)*i0*k1+1
    enddo

    js=1
    jf=j0-1
    if (mylat .eq. 0) js=2
    if (mylat .eq. ngy0-1) jf=j0-2

    nn(1)=k1
    nn(2)=j2t
    nn(3)=i2t
    nn(4)=12
    nn(5)=k0
    nn(6)=1
    ns_kji(1)=1
    ns_kji(2)=mylat*j2+1
    ns_kji(3)=mylon*i2+1
    nc_kji(1)=k1
    nc_kji(2)=j2
    nc_kji(3)=i2
    ns_tji(1)=1
    ns_tji(2)=mylat*j2+1
    ns_tji(3)=mylon*i2+1
    nc_tji(1)=12
    nc_tji(2)=j2
    nc_tji(3)=i2
    nf_kji(1)=k0
    nf_kji(2)=j2
    nf_kji(3)=i2
    ns_ji(1)=mylat*j2+1
    ns_ji(2)=mylon*i2+1
    nc_ji(1)=j2
    nc_ji(2)=i2
    ns_1=1
    nc_1=1


    ns_kji2(3)=1
    ns_kji2(2)=mylat*j2+1
    ns_kji2(1)=mylon*i2+1
    nc_kji2(3)=k1
    nc_kji2(2)=j2
    nc_kji2(1)=i2
    ns_tji2(3)=1
    ns_tji2(2)=mylat*j2+1
    ns_tji2(1)=mylon*i2+1
    nc_tji2(3)=12
    nc_tji2(2)=j2
    nc_tji2(1)=i2
    nf_kji2(3)=k0
    nf_kji2(2)=j2
    nf_kji2(1)=i2
    ns_ji2(2)=mylat*j2+1
    ns_ji2(1)=mylon*i2+1
    nc_ji2(2)=j2
    nc_ji2(1)=i2
end subroutine


! ----------------------------------------------------------------------
subroutine mpi_exch_3d_r4(scr)
    dimension scr(i0,j0,k1)

    call mpi_sendrecv(scr(2,1,1),1,m_vlon3d,m_w,1,scr(i0,1,1),1,m_vlon3d,m_e,1,m_cart,istat,ierr1)
    call mpi_sendrecv(scr(i1,1,1),1,m_vlon3d,m_e,1,scr(1,1,1),1,m_vlon3d,m_w,1,m_cart,istat,ierr2)
    call mpi_sendrecv(scr(1,2,1),1,m_vlat3d,m_s,1,scr(1,j0,1),1,m_vlat3d,m_n,1,m_cart,istat,ierr3)
    call mpi_sendrecv(scr(1,j1,1),1,m_vlat3d,m_n,1,scr(1,1,1),1,m_vlat3d,m_s,1,m_cart,istat,ierr4)
    if(ierr1+ierr2+ierr3+ierr4.ne.0)write(*,'(a)')'mpi_exch_3d error'
end subroutine

subroutine mpi_exch_3d_r8(scr)
    real*8 scr
    dimension scr(i0,j0,k1)

    call mpi_sendrecv(scr(2,1,1),1,m_vlon3d,m_w,1,scr(i0,1,1),1,m_vlon3d,m_e,1,m_cart,istat,ierr1)
    call mpi_sendrecv(scr(i1,1,1),1,m_vlon3d,m_e,1,scr(1,1,1),1,m_vlon3d,m_w,1,m_cart,istat,ierr2)
    call mpi_sendrecv(scr(1,2,1),1,m_vlat3d,m_s,1,scr(1,j0,1),1,m_vlat3d,m_n,1,m_cart,istat,ierr3)
    call mpi_sendrecv(scr(1,j1,1),1,m_vlat3d,m_n,1,scr(1,1,1),1,m_vlat3d,m_s,1,m_cart,istat,ierr4)
    if(ierr1+ierr2+ierr3+ierr4.ne.0)write(*,'(a)')'mpi_exch_3d error'
end subroutine


! ----------------------------------------------------------------------
subroutine mpi_exch_2d_r4(scr)
    dimension scr(i0,j0)
    call mpi_sendrecv(scr(2,1),1,m_vlon2d,m_w,1,scr(i0,1),1,m_vlon2d,m_e,1,m_cart,istat,ierr1)
    call mpi_sendrecv(scr(i1,1),1,m_vlon2d,m_e,1,scr(1,1),1,m_vlon2d,m_w,1,m_cart,istat,ierr2)
    call mpi_sendrecv(scr(1,2),1,m_vlat2d,m_s,1,scr(1,j0),1,m_vlat2d,m_n,1,m_cart,istat,ierr3)
    call mpi_sendrecv(scr(1,j1),1,m_vlat2d,m_n,1,scr(1,1),1,m_vlat2d,m_s,1,m_cart,istat,ierr4)

    if(ierr1+ierr2+ierr3+ierr4.ne.0)write(*,'(a)')'mpi_exch_2d error'
end subroutine


! ----------------------------------------------------------------------
subroutine mpi_exch_2d_r8(scr)
    real*8 scr(i0,j0)

    call mpi_sendrecv(scr(2,1),1,m_v8lonx2d,m_w,1,scr(i0,1),1,m_v8lonx2d,m_e,1,m_cart,istat,ierr1)
    call mpi_sendrecv(scr(i1,1),1,m_v8lonx2d,m_e,1,scr(1,1),1,m_v8lonx2d,m_w,1,m_cart,istat,ierr2)
    call mpi_sendrecv(scr(1,2),1,m_v8latx2d,m_s,1,scr(1,j0),1,m_v8latx2d,m_n,1,m_cart,istat,ierr3)
    call mpi_sendrecv(scr(1,j1),1,m_v8latx2d,m_n,1,scr(1,1),1,m_v8latx2d,m_s,1,m_cart,istat,ierr4)
    if(ierr1+ierr2+ierr3+ierr4.ne.0)write(*,'(a)')'mpi_exch_2d error'
end subroutine


! ----------------------------------------------------------------------
subroutine mpi_peri_all(u2,v2,t2,s2,u1,v1,t1,s1,p,ub,vb,tb,sb,pb)
    parameter(nlat=14*i0*k1,nlon=14*j0*k1)
    dimension u2(i0,j0,k1),v2(i0,j0,k1),t2(i0,j0,k1),s2(i0,j0,k1),u1(i0,j0,k1),v1(i0,j0,k1),t1(i0,j0,k1),s1(i0,j0,k1),p(i0,j0,k1),ub(i0,j0,k1),vb(i0,j0,k1),tb(i0,j0,k1),sb(i0,j0,k1),pb(j0,j0,k1)
    dimension rbe(nlon),rbw(nlon),sbe(nlon),sbw(nlon),rbn(nlat),rbs(nlat),sbn(nlat),sbs(nlat)

    call combosend(p,i0,j0,k1,sbw(npx(1)),2,sbe(npx(1)),i1,ngy1,mylat,sbn(npy(1)),j1,sbs(npy(1)),2)
    call combosend(t2,i0,j0,k1,sbw(npx(2)),2,sbe(npx(2)),i1,ngy1,mylat,sbn(npy(2)),j1,sbs(npy(2)),2)
    call combosend(s2,i0,j0,k1,sbw(npx(3)),2,sbe(npx(3)),i1,ngy1,mylat,sbn(npy(3)),j1,sbs(npy(3)),2)
    call combosend(u2,i0,j0,k1,sbw(npx(4)),2,sbe(npx(4)),i1,ngy1,mylat,sbn(npy(4)),j1,sbs(npy(4)),2)
    call combosend(v2,i0,j0,k1,sbw(npx(5)),2,sbe(npx(5)),i1,ngy1,mylat,sbn(npy(5)),j1,sbs(npy(5)),2)
    call combosend(p,i0,j0,k1,sbw(npx(6)),3,sbe(npx(6)),i2,ngy1,mylat,sbn(npy(6)),j2,sbs(npy(6)),3)
    call combosend(t2,i0,j0,k1,sbw(npx(7)),3,sbe(npx(7)),i2,ngy1,mylat,sbn(npy(7)),j2,sbs(npy(7)),3)
    call combosend(s2,i0,j0,k1,sbw(npx(8)),3,sbe(npx(8)),i2,ngy1,mylat,sbn(npy(8)),j2,sbs(npy(8)),3)
    call combosend(u2,i0,j0,k1,sbw(npx(9)),3,sbe(npx(9)),i2,ngy1,mylat,sbn(npy(9)),j2,sbs(npy(9)),3)
    call combosend(v2,i0,j0,k1,sbw(npx(10)),3,sbe(npx(10)),i2,ngy1,mylat,sbn(npy(10)),j2,sbs(npy(10)),3)
    call combosend(t1,i0,j0,k1,sbw(npx(11)),2,sbe(npx(11)),i1,ngy1,mylat,sbn(npy(11)),j1,sbs(npy(11)),2)
    call combosend(s1,i0,j0,k1,sbw(npx(12)),2,sbe(npx(12)),i1,ngy1,mylat,sbn(npy(12)),j1,sbs(npy(12)),2)
    call combosend(u1,i0,j0,k1,sbw(npx(13)),2,sbe(npx(13)),i1,ngy1,mylat,sbn(npy(13)),j1,sbs(npy(13)),2)
    call combosend(v1,i0,j0,k1,sbw(npx(14)),2,sbe(npx(14)),i1,ngy1,mylat,sbn(npy(14)),j1,sbs(npy(14)),2)
    call mpi_sendrecv(sbw(1),nlon,mpi_real8,m_w,1,rbe(1),nlon,mpi_real8,m_e,1,m_cart,istat,ierr)
    call mpi_sendrecv(sbe(1),nlon,mpi_real8,m_e,1,rbw(1),nlon,mpi_real8,m_w,1,m_cart,istat,ierr)
    call mpi_sendrecv(sbs(1),nlat,mpi_real8,m_s,1,rbn(1),nlat,mpi_real8,m_n,1,m_cart,istat,ierr)
    call mpi_sendrecv(sbn(1),nlat,mpi_real8,m_n,1,rbs(1),nlat,mpi_real8,m_s,1,m_cart,istat,ierr)
    call comborecv(p,i0,j0,k1,rbw(npx(1)),1,rbe(npx(1)),i0,ngy1,mylat,rbn(npy(1)),j0,rbs(npy(1)),1)
    call comborecv(t2,i0,j0,k1,rbw(npx(2)),1,rbe(npx(2)),i0,ngy1,mylat,rbn(npy(2)),j0,rbs(npy(2)),1)
    call comborecv(s2,i0,j0,k1,rbw(npx(3)),1,rbe(npx(3)),i0,ngy1,mylat,rbn(npy(3)),j0,rbs(npy(3)),1)
    call comborecv(u2,i0,j0,k1,rbw(npx(4)),1,rbe(npx(4)),i0,ngy1,mylat,rbn(npy(4)),j0,rbs(npy(4)),1)
    call comborecv(v2,i0,j0,k1,rbw(npx(5)),1,rbe(npx(5)),i0,ngy1,mylat,rbn(npy(5)),j0,rbs(npy(5)),1)
    call comborecv(pb,i0,j0,k1,rbw(npx(6)),1,rbe(npx(6)),i0,ngy1,mylat,rbn(npy(6)),j0,rbs(npy(6)),1)
    call comborecv(tb,i0,j0,k1,rbw(npx(7)),1,rbe(npx(7)),i0,ngy1,mylat,rbn(npy(7)),j0,rbs(npy(7)),1)
    call comborecv(sb,i0,j0,k1,rbw(npx(8)),1,rbe(npx(8)),i0,ngy1,mylat,rbn(npy(8)),j0,rbs(npy(8)),1)
    call comborecv(ub,i0,j0,k1,rbw(npx(9)),1,rbe(npx(9)),i0,ngy1,mylat,rbn(npy(9)),j0,rbs(npy(9)),1)
    call comborecv(vb,i0,j0,k1,rbw(npx(10)),1,rbe(npx(10)),i0,ngy1,mylat,rbn(npy(10)),j0,rbs(npy(10)),1)
    call comborecv(t1,i0,j0,k1,rbw(npx(11)),1,rbe(npx(11)),i0,ngy1,mylat,rbn(npy(11)),j0,rbs(npy(11)),1)
    call comborecv(s1,i0,j0,k1,rbw(npx(12)),1,rbe(npx(12)),i0,ngy1,mylat,rbn(npy(12)),j0,rbs(npy(12)),1)
    call comborecv(u1,i0,j0,k1,rbw(npx(13)),1,rbe(npx(13)),i0,ngy1,mylat,rbn(npy(13)),j0,rbs(npy(13)),1)
    call comborecv(v1,i0,j0,k1,rbw(npx(14)),1,rbe(npx(14)),i0,ngy1,mylat,rbn(npy(14)),j0,rbs(npy(14)),1)
end subroutine


! ----------------------------------------------------------------------
subroutine mpi_peri_scr(scr1,scr2,ubf,vbf)
    parameter(nlt=2*i0,nln=2*j0)
    dimension scr1(i0,j0),scr2(i0,j0),ubf(i0,j0),vbf(i0,j0)
    dimension rbe(nln),rbw(nln),sbe(nln),sbw(nln),rbn(nlt),rbs(nlt),sbn(nlt),sbs(nlt)

    call combosend(scr1,i0,j0,1,sbw(1),2,sbe(1),i2,ngy1,mylat,sbn(1),j2,sbs(1),2)
    call combosend(scr2,i0,j0,1,sbw(j0+1),2,sbe(j0+1),i2,ngy1,mylat,sbn(i0+1),j2,sbs(i0+1),2)
    call mpi_sendrecv(sbw(1),nln,mpi_real8,m_w,1,rbe(1),nln,mpi_real8,m_e,1,m_cart,istat,ierr)
    call mpi_sendrecv(sbe(1),nln,mpi_real8,m_e,1,rbw(1),nln,mpi_real8,m_w,1,m_cart,istat,ierr)
    call mpi_sendrecv(sbs(1),nlt,mpi_real8,m_s,1,rbn(1),nlt,mpi_real8,m_n,1,m_cart,istat,ierr)
    call mpi_sendrecv(sbn(1),nlt,mpi_real8,m_n,1,rbs(1),nlt,mpi_real8,m_s,1,m_cart,istat,ierr)
    call comborecv(ubf,i0,j0,1,rbw(1),1,rbe(1),i0,ngy1,mylat,rbn(1),j0,rbs(1),1)
    call comborecv(vbf,i0,j0,1,rbw(j0+1),1,rbe(j0+1),i0,ngy1,mylat,rbn(i0+1),j0,rbs(i0+1),1)
end subroutine


! ----------------------------------------------------------------------
subroutine mpi_peri_uv(u2,v2,ub,vb)
    parameter(nlat=4*i0*k1,nlon=4*j0*k1)
    dimension u2(i0,j0,k1),v2(i0,j0,k1),ub(i0,j0,k1),vb(i0,j0,k1)
    dimension rbe(nlon),rbw(nlon),sbe(nlon),sbw(nlon),rbn(nlat),rbs(nlat),sbn(nlat),sbs(nlat)

    call combosend(u2,i0,j0,k1,sbw(npx(1)),2,sbe(npx(1)),i1,ngy1,mylat,sbn(npy(1)),j1,sbs(npy(1)),2)
    call combosend(v2,i0,j0,k1,sbw(npx(2)),2,sbe(npx(2)),i1,ngy1,mylat,sbn(npy(2)),j1,sbs(npy(2)),2)
    call combosend(u2,i0,j0,k1,sbw(npx(3)),3,sbe(npx(3)),i2,ngy1,mylat,sbn(npy(3)),j2,sbs(npy(3)),3)
    call combosend(v2,i0,j0,k1,sbw(npx(4)),3,sbe(npx(4)),i2,ngy1,mylat,sbn(npy(4)),j2,sbs(npy(4)),3)
    call mpi_sendrecv(sbw(1),nlon,mpi_real8,m_w,1,rbe(1),nlon,mpi_real8,m_e,1,m_cart,istat,ierr)
    call mpi_sendrecv(sbe(1),nlon,mpi_real8,m_e,1,rbw(1),nlon,mpi_real8,m_w,1,m_cart,istat,ierr)
    call mpi_sendrecv(sbs(1),nlat,mpi_real8,m_s,1,rbn(1),nlat,mpi_real8,m_n,1,m_cart,istat,ierr)
    call mpi_sendrecv(sbn(1),nlat,mpi_real8,m_n,1,rbs(1),nlat,mpi_real8,m_s,1,m_cart,istat,ierr)
    call comborecv(u2,i0,j0,k1,rbw(npx(1)),1,rbe(npx(1)),i0,ngy1,mylat,rbn(npy(1)),j0,rbs(npy(1)),1)
    call comborecv(v2,i0,j0,k1,rbw(npx(2)),1,rbe(npx(2)),i0,ngy1,mylat,rbn(npy(2)),j0,rbs(npy(2)),1)
    call comborecv(ub,i0,j0,k1,rbw(npx(3)),1,rbe(npx(3)),i0,ngy1,mylat,rbn(npy(3)),j0,rbs(npy(3)),1)
    call comborecv(vb,i0,j0,k1,rbw(npx(4)),1,rbe(npx(4)),i0,ngy1,mylat,rbn(npy(4)),j0,rbs(npy(4)),1)
end subroutine

! ----------------------------------------------------------------------
subroutine mpi_peri_ts(t1,s1)
    parameter(nlat=2*i0*k1,nlon=2*j0*k1)
    dimension t1(i0,j0,k1),s1(i0,j0,k1)
    dimension rbe(nlon),rbw(nlon),sbe(nlon),sbw(nlon),rbn(nlat),rbs(nlat),sbn(nlat),sbs(nlat)

    call combosend(t1,i0,j0,k1,sbw(npx(1)),2,sbe(npx(1)),i1,ngy1,mylat,sbn(npy(1)),j1,sbs(npy(1)),2)
    call combosend(s1,i0,j0,k1,sbw(npx(2)),2,sbe(npx(2)),i1,ngy1,mylat,sbn(npy(2)),j1,sbs(npy(2)),2)
    call mpi_sendrecv(sbw(1),nlon,mpi_real8,m_w,1,rbe(1),nlon,mpi_real8,m_e,1,m_cart,istat,ierr)
    call mpi_sendrecv(sbe(1),nlon,mpi_real8,m_e,1,rbw(1),nlon,mpi_real8,m_w,1,m_cart,istat,ierr)
    call mpi_sendrecv(sbs(1),nlat,mpi_real8,m_s,1,rbn(1),nlat,mpi_real8,m_n,1,m_cart,istat,ierr)
    call mpi_sendrecv(sbn(1),nlat,mpi_real8,m_n,1,rbs(1),nlat,mpi_real8,m_s,1,m_cart,istat,ierr)
    call comborecv(t1,i0,j0,k1,rbw(npx(1)),1,rbe(npx(1)),i0,ngy1,mylat,rbn(npy(1)),j0,rbs(npy(1)),1)
    call comborecv(s1,i0,j0,k1,rbw(npx(2)),1,rbe(npx(2)),i0,ngy1,mylat,rbn(npy(2)),j0,rbs(npy(2)),1)
end subroutine


! ----------------------------------------------------------------------
subroutine combosend(sbuf,ni0,nj0,nk0,sbw,iw,sbe,ie,ngy0,mylat,sbn,jn,sbs,js)
    dimension sbuf(ni0,nj0,nk0),sbw(nj0*nk0),sbe(nj0*nk0),sbn(ni0*nk0),sbs(ni0*nk0)

    do 10 k=1,nk0
    jt=k*nj0-nj0
    do 10 j=1,nj0
    sbe(jt+j)=sbuf(ie,j,k)
    10   sbw(jt+j)=sbuf(iw,j,k)

    if (mylat .ne. 0) then
	do 20 k=1,nk0
	it=k*ni0-ni0
	do 20 i=1,ni0
	20   sbs(it+i)=sbuf(i,js,k)
    endif
    if (mylat .ne. ngy0) then
	do 30 k=1,nk0
	it=k*ni0-ni0
	do 30 i=1,ni0
	30   sbn(it+i)=sbuf(i,jn,k)
    endif
end subroutine


! ----------------------------------------------------------------------
subroutine comborecv(rbuf,ni0,nj0,nk0,rbw,iw,rbe,ie,ngy0,mylat,rbn,jn,rbs,js)
    dimension rbuf(ni0,nj0,nk0),rbw(nj0*nk0),rbe(nj0*nk0),rbn(ni0*nk0),rbs(ni0*nk0)
    do 10 k=1,nk0
    jt=k*nj0-nj0
    do 10 j=1,nj0
    rbuf(ie,j,k)=rbe(jt+j)
    10   rbuf(iw,j,k)=rbw(jt+j)

    if (mylat .ne. 0) then
	do 20 k=1,nk0
	it=k*ni0-ni0
	do 20 i=1,ni0
	20   rbuf(i,js,k)=rbs(it+i)
    endif
    if (mylat .ne. ngy0) then
	do 30 k=1,nk0
	it=k*ni0-ni0
	do 30 i=1,ni0
	30   rbuf(i,jn,k)=rbn(it+i)
    endif
end subroutine


subroutine finalize_comm

end subroutine


end module