realloc3.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

#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
   return
end subroutine realloc3