#include <misc.h>#include <params.h>subroutine realloc3(grlps1  ,grt1    ,grz1    ,grd1    ,grfu1   , &                    grfv1   ,grut1   ,grvt1   ,grrh1   ,grlps2  , &                    grt2    ,grz2    ,grd2    ,grfu2   ,grfv2   , &                    grut2   ,grvt2   ,grrh2   )!----------------------------------------------------------------------- ! ! Purpose: ! Reallocation routine for Gaussian quadrature.! ! Method: ! ! Author: ! Original version:  J. Rosinski! Standardized:      J. Rosinski, Oct 1995!                    J. Truesdale, Feb. 1996! !-----------------------------------------------------------------------! $Id: realloc3.F90,v 1.4 2001/02/15 02:23:20 rosinski Exp $! $Author: rosinski $!!-----------------------------------------------------------------------#ifdef SPMD   use precision   use pmgrid   use pspect   use mpishorthand   use spmd_dyn!-----------------------------------------------------------------------   implicit none!------------------------------Parameters-------------------------------   integer msgid   parameter (msgid = 3000)!-----------------------------------------------------------------------!! Input arguments!   real(r8), intent(in) :: grlps1(2*pmmax,plat/2)      ! ----------------------------   real(r8), intent(in) :: grt1(plev,2*pmmax,plat/2)   ! |   real(r8), intent(in) :: grz1(plev,2*pmmax,plat/2)   ! |   real(r8), intent(in) :: grd1(plev,2*pmmax,plat/2)   ! |   real(r8), intent(in) :: grfu1(plev,2*pmmax,plat/2)  ! |   real(r8), intent(in) :: grfv1(plev,2*pmmax,plat/2)  ! |   real(r8), intent(in) :: grut1(plev,2*pmmax,plat/2)  ! |   real(r8), intent(in) :: grvt1(plev,2*pmmax,plat/2)  ! |   real(r8), intent(in) :: grrh1(plev,2*pmmax,plat/2)  ! |- see linems and quad for   real(r8), intent(in) :: grlps2(2*pmmax,plat/2)      ! |  definitions: these variables are   real(r8), intent(in) :: grt2(plev,2*pmmax,plat/2)   ! |  declared here for data scoping   real(r8), intent(in) :: grz2(plev,2*pmmax,plat/2)   ! |   real(r8), intent(in) :: grd2(plev,2*pmmax,plat/2)   ! |   real(r8), intent(in) :: grfu2(plev,2*pmmax,plat/2)  ! |   real(r8), intent(in) :: grfv2(plev,2*pmmax,plat/2)  ! |   real(r8), intent(in) :: grut2(plev,2*pmmax,plat/2)  ! |   real(r8), intent(in) :: grvt2(plev,2*pmmax,plat/2)  ! |   real(r8), intent(in) :: grrh2(plev,2*pmmax,plat/2)  ! ----------------------------!!---------------------------Local workspace-----------------------------!   integer procid   integer num   procid = npes - iam - 1   if (cut(2,iam).le.plat/2) then!! Send gr..1 to, receive gr..2 from, my neighbor in the northern hemisphere!      num = 2*pmmax*numlats      call mpisendrecv (grlps1(1,begirow), num, mpir8, procid, msgid, &                        grlps2(1,begirow), num, mpir8, procid, msgid, mpicom)      num = plev*2*pmmax*numlats      call mpisendrecv (grt1(1,1,begirow),num,mpir8,procid,msgid, &                        grt2(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grz1(1,1,begirow),num,mpir8,procid,msgid, &                        grz2(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grd1(1,1,begirow),num,mpir8,procid,msgid, &                        grd2(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grfu1(1,1,begirow),num,mpir8,procid,msgid, &                        grfu2(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grfv1(1,1,begirow),num,mpir8,procid,msgid, &                        grfv2(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grut1(1,1,begirow),num,mpir8,procid,msgid, &                        grut2(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grvt1(1,1,begirow),num,mpir8,procid,msgid, &                        grvt2(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grrh1(1,1,begirow),num,mpir8,procid,msgid, &                        grrh2(1,1,begirow),num,mpir8,procid,msgid,mpicom)   else!! Send gr..2 to, receive gr..1 from, my neighbor in the southern hemisphere!      num = 2*pmmax*numlats      call mpisendrecv (grlps2(1,begirow),num,mpir8,procid,msgid, &                        grlps1(1,begirow),num,mpir8,procid,msgid,mpicom)      num = plev*2*pmmax*numlats      call mpisendrecv (grt2(1,1,begirow),num,mpir8,procid,msgid, &                        grt1(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grz2(1,1,begirow),num,mpir8,procid,msgid, &                        grz1(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grd2(1,1,begirow),num,mpir8,procid,msgid, &                        grd1(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grfu2(1,1,begirow),num,mpir8,procid,msgid, &                        grfu1(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grfv2(1,1,begirow),num,mpir8,procid,msgid, &                        grfv1(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grut2(1,1,begirow),num,mpir8,procid,msgid, &                        grut1(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grvt2(1,1,begirow),num,mpir8,procid,msgid, &                        grvt1(1,1,begirow),num,mpir8,procid,msgid,mpicom)      call mpisendrecv (grrh2(1,1,begirow),num,mpir8,procid,msgid, &                        grrh1(1,1,begirow),num,mpir8,procid,msgid,mpicom)   end if#endif   returnend subroutine realloc3