EXCH.f

Go to the documentation of this file.

      SUBROUTINE exch(A)

      use ctlblk_mod, only: num_procs, jend, iup, jsta, idn, mpi_comm_comp, im,&
              jsta_2l, jend_2u
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      implicit none
!     
      include 'mpif.h'
!
      real,intent(inout) :: a ( im,jsta_2l:jend_2u )
      integer status(mpi_status_size)
      integer ierr, jstam1, jendp1
!
!     write(0,*) 'mype=',me,'num_procs=',num_procs,'im=',im,'jsta_2l=', &
!             jsta_2l,'jend_2u=',jend_2u,'jend=',jend,'iup=',iup,'jsta=', &
!             jsta,'idn=',idn
      if ( num_procs <= 1 ) return
!
      jstam1 = max(jsta_2l,jsta-1)                        ! Moorthi
      call mpi_sendrecv(a(1,jend),im,mpi_real,iup,1,             &
     &                  a(1,jstam1),im,mpi_real,idn,1,           &
     &                  mpi_comm_comp,status,ierr)
!      print *,'mype=',me,'in EXCH, after first mpi_sendrecv'
      if ( ierr /= 0 ) then
         print *, ' problem with first sendrecv in exch, ierr = ',ierr
         stop
      end if
      jendp1 = min(jend+1,jend_2u)                          ! Moorthi
      call mpi_sendrecv(a(1,jsta),im,mpi_real,idn,1,             &
     &                  a(1,jendp1),im,mpi_real,iup,1,           &
     &                  mpi_comm_comp,status,ierr)
!      print *,'mype=',me,'in EXCH, after second mpi_sendrecv'
      if ( ierr /= 0 ) then
         print *, ' problem with second sendrecv in exch, ierr = ',ierr
         stop
      end if
!
      end

!!@PROCESS NOCHECK
      subroutine exch_f(a)
 
      use ctlblk_mod, only: num_procs, jend, iup, jsta, idn,    &
     &                      mpi_comm_comp, im, jsta_2l, jend_2u
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      implicit none
!
      include 'mpif.h'
!
      real,intent(inout) :: a ( im,jsta_2l:jend_2u )
      integer status(mpi_status_size)
      integer ierr, jstam1, jendp1
!
      if ( num_procs == 1 ) return
!
      jstam1 = max(jsta_2l,jsta-1)                       ! Moorthi
      call mpi_sendrecv(a(1,jend),im,mpi_real,iup,1,           &
     &                  a(1,jstam1),im,mpi_real,idn,1,         &
     &                  mpi_comm_comp,status,ierr)
      if ( ierr /= 0 ) then
         print *, ' problem with first sendrecv in exch, ierr = ',ierr
         stop
      end if
      jendp1=min(jend+1,jend_2u)                         ! Moorthi
      call mpi_sendrecv(a(1,jsta),im,mpi_real,idn,1,           &
     &                  a(1,jendp1),im,mpi_real,iup,1,         &
     &                  mpi_comm_comp,status,ierr)
      if ( ierr /= 0 ) then
         print *, ' problem with second sendrecv in exch, ierr = ',ierr
         stop
      end if
!
      end