Class comlib
In: LatticeClass/comlib.F90
constants_module qmxf03_module mpi omp_lib comlib dot/f_263.png

Interface subroutines to MPI

Methods

Included Modules

constants_module qmxf03_module mpi omp_lib

Public Instance methods

Subroutine :
send :complex(DP), intent(in)
recv(0:m_num_procs-1) :complex(DP), intent(inout)

[Source]

subroutine comlib_allgather_c16(send,recv)
  implicit none
  complex(DP), intent(in)    :: send
  complex(DP), intent(inout) :: recv(0:m_num_procs-1)
  complex(DP) :: rtmp(1,0:m_num_procs-1),stmp(1)
  integer :: ierr,i
#ifdef _QMX_
  stmp(1) = send
  call qmx_allgather_dcmplx(1,stmp,recv)
  do i=0,m_num_procs-1
    recv(i) = rtmp(1,i)
  enddo
#else
  call MPI_Allgather(send,1,MPI_COMPLEX16, recv,1,MPI_COMPLEX16,MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
send :complex(SP), intent(in)
recv(0:m_num_procs-1) :complex(SP), intent(inout)

[Source]

subroutine comlib_allgather_c8(send,recv)
  implicit none
  complex(SP), intent(in)    :: send
  complex(SP), intent(inout) :: recv(0:m_num_procs-1)
  complex(SP) :: rtmp(1,0:m_num_procs-1),stmp(1)
  integer :: ierr,i
#ifdef _QMX_
  stmp(1) = send
  call qmx_allgather_cmplx(1,stmp,recv)
  do i=0,m_num_procs-1
    recv(i) = rtmp(1,i)
  enddo
#else
  call MPI_Allgather(send,1,MPI_COMPLEX8, recv,1,MPI_COMPLEX8,MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
send :integer, intent(in)
recv(0:m_num_procs-1) :integer, intent(inout)

[Source]

subroutine comlib_allgather_i4(send,recv)
  implicit none
  integer, intent(in)    :: send
  integer, intent(inout) :: recv(0:m_num_procs-1)
  integer :: rtmp(1,0:m_num_procs-1),stmp(1)
  integer :: ierr,i
#ifdef _QMX_
  stmp(1) = send
  call qmx_allgather_int(1,stmp,recv)
  do i=0,m_num_procs-1
    recv(i) = rtmp(1,i)
  enddo
#else
  call MPI_Allgather(send,1,MPI_INTEGER, recv,1,MPI_INTEGER,MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
send :real(DP), intent(in)
recv(0:m_num_procs-1) :real(DP), intent(inout)

[Source]

subroutine comlib_allgather_r8(send,recv)
  implicit none
  real(DP), intent(in)    :: send
  real(DP), intent(inout) :: recv(0:m_num_procs-1)
  real(DP) :: rtmp(1,0:m_num_procs-1),stmp(1)
  integer :: ierr,i
#ifdef _QMX_
  stmp(1) = send
  call qmx_allgather_double(1,stmp,recv)
  do i=0,m_num_procs-1
    recv(i) = rtmp(1,i)
  enddo
#else
  call MPI_Allgather(send,1,MPI_REAL8, recv,1,MPI_REAL8,MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
send :real(SP), intent(in)
recv(0:m_num_procs-1) :real(SP), intent(inout)

[Source]

subroutine comlib_allgather_r4(send,recv)
  implicit none
  real(SP), intent(in)    :: send
  real(SP), intent(inout) :: recv(0:m_num_procs-1)
  real(SP) :: rtmp(1,0:m_num_procs-1),stmp(1)
  integer :: ierr,i
#ifdef _QMX_
  stmp(1) = send
  call qmx_allgather_float(1,stmp,recv)
  do i=0,m_num_procs-1
    recv(i) = rtmp(1,i)
  enddo
#else
  call MPI_Allgather(send,1,MPI_REAL4, recv,1,MPI_REAL4,MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
send(:) :complex(DP), intent(in)
recv(:,:) :complex(DP), intent(inout)

[Source]

subroutine comlib_allgather_c16_array(send,recv)
  implicit none
  complex(DP), intent(in)    :: send(:)
  complex(DP), intent(inout) :: recv(:,:)
  integer :: ssize,rsize,psize
  integer :: ierr,i
  ssize = SIZE(send)
  rsize = SIZE(recv,1)
  psize = SIZE(recv,2)
  if ( psize /= m_num_procs ) then
    write(*,'("ERROR : comlib_allgather(send,recv): recv(:,:) should have recv(:,0:num_procs-1) shape.")')
    goto 99
  endif
  if ( rsize /= ssize ) then
    write(*,'("ERROR : comlib_allgather(send,recv): send(:) and recv(:,:) should have same 1st dim size.")')
    goto 99
  endif
#ifdef _QMX_
  call qmx_allgather_dcmplx(ssize,send,recv)
#else
  call MPI_Allgather(send,ssize,MPI_COMPLEX16, recv,ssize,MPI_COMPLEX16,MPI_COMM_WORLD,ierr)
#endif
  return
99 call comlib_finalize()
  stop
end subroutine
Subroutine :
send(:) :complex(SP), intent(in)
recv(:,:) :complex(SP), intent(inout)

[Source]

subroutine comlib_allgather_c8_array(send,recv)
  implicit none
  complex(SP), intent(in)    :: send(:)
  complex(SP), intent(inout) :: recv(:,:)
  integer :: ssize,rsize,psize
  integer :: ierr,i
  ssize = SIZE(send)
  rsize = SIZE(recv,1)
  psize = SIZE(recv,2)
  if ( psize /= m_num_procs ) then
    write(*,'("ERROR : comlib_allgather(send,recv): recv(:,:) should have recv(:,0:num_procs-1) shape.")')
    goto 99
  endif
  if ( rsize /= ssize ) then
    write(*,'("ERROR : comlib_allgather(send,recv): send(:) and recv(:,:) should have same 1st dim size.")')
    goto 99
  endif
#ifdef _QMX_
  call qmx_allgather_cmplx(ssize,send,recv)
#else
  call MPI_Allgather(send,ssize,MPI_COMPLEX8, recv,ssize,MPI_COMPLEX8,MPI_COMM_WORLD,ierr)
#endif
  return
99 call comlib_finalize()
  stop
end subroutine
Subroutine :
send(:) :integer, intent(in)
recv(:,:) :integer, intent(inout)

[Source]

subroutine comlib_allgather_i4_array(send,recv)
  implicit none
  integer, intent(in)    :: send(:)
  integer, intent(inout) :: recv(:,:)
  integer :: ssize,rsize,psize
  integer :: ierr,i
  ssize = SIZE(send)
  rsize = SIZE(recv,1)
  psize = SIZE(recv,2)
  if ( psize /= m_num_procs ) then
    write(*,'("ERROR : comlib_allgather(send,recv): recv(:,:) should have recv(:,0:num_procs-1) shape.")')
    goto 99
  endif
  if ( rsize /= ssize ) then
    write(*,'("ERROR : comlib_allgather(send,recv): send(:) and recv(:,:) should have same 1st dim size.")')
    goto 99
  endif
#ifdef _QMX_
  call qmx_allgather_int(ssize,send,recv)
#else
  call MPI_Allgather(send,ssize,MPI_INTEGER, recv,ssize,MPI_INTEGER,MPI_COMM_WORLD,ierr)
#endif
  return
99 call comlib_finalize()
  stop
end subroutine
Subroutine :
send(:) :real(DP), intent(in)
recv(:,:) :real(DP), intent(inout)

[Source]

subroutine comlib_allgather_r8_array(send,recv)
  implicit none
  real(DP), intent(in)    :: send(:)
  real(DP), intent(inout) :: recv(:,:)
  integer :: ssize,rsize,psize
  integer :: ierr,i
  ssize = SIZE(send)
  rsize = SIZE(recv,1)
  psize = SIZE(recv,2)
  if ( psize /= m_num_procs ) then
    write(*,'("ERROR : comlib_allgather(send,recv): recv(:,:) should have recv(:,0:num_procs-1) shape.")')
    goto 99
  endif
  if ( rsize /= ssize ) then
    write(*,'("ERROR : comlib_allgather(send,recv): send(:) and recv(:,:) should have same 1st dim size.")')
    goto 99
  endif
#ifdef _QMX_
  call qmx_allgather_double(ssize,send,recv)
#else
  call MPI_Allgather(send,ssize,MPI_REAL8, recv,ssize,MPI_REAL8,MPI_COMM_WORLD,ierr)
#endif
  return
99 call comlib_finalize()
  stop
end subroutine
Subroutine :
send(:) :real(SP), intent(in)
recv(:,:) :real(SP), intent(inout)

[Source]

subroutine comlib_allgather_r4_array(send,recv)
  implicit none
  real(SP), intent(in)    :: send(:)
  real(SP), intent(inout) :: recv(:,:)
  integer :: ssize,rsize,psize
  integer :: ierr,i
  ssize = SIZE(send)
  rsize = SIZE(recv,1)
  psize = SIZE(recv,2)
  if ( psize /= m_num_procs ) then
    write(*,'("ERROR : comlib_allgather(send,recv): recv(:,:) should have recv(:,0:num_procs-1) shape.")')
    goto 99
  endif
  if ( rsize /= ssize ) then
    write(*,'("ERROR : comlib_allgather(send,recv): send(:) and recv(:,:) should have same 1st dim size.")')
    goto 99
  endif
#ifdef _QMX_
  call qmx_allgather_float(ssize,send,recv)
#else
  call MPI_Allgather(send,ssize,MPI_REAL4, recv,ssize,MPI_REAL4,MPI_COMM_WORLD,ierr)
#endif
  return
99 call comlib_finalize()
  stop
end subroutine
Subroutine :

[Source]

subroutine comlib_barrier
  implicit none
  integer :: ierr
#ifdef _QMX_
  call qmx_barrier()
#else
  call MPI_Barrier(MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
arg :character(LEN=*), intent(inout)
ids :integer, intent(in)

[Source]

subroutine comlib_bcast_char(arg,ids)
  implicit none
  character(LEN=*), intent(inout) :: arg
  integer, intent(in) :: ids
  integer :: ilen,ierr
  ilen=LEN(arg)
#ifdef _QMX_
  call qmx_bcast_char(ilen,arg,ids)
#else
  call MPI_BCAST(arg,ilen,MPI_CHARACTER,ids,MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
arg :complex(DP), intent(inout)
ids :integer, intent(in)

[Source]

subroutine comlib_bcast_c16(arg,ids)
  implicit none
  complex(DP), intent(inout) :: arg
  integer, intent(in) :: ids
  complex(DP) :: tmp(1)
  integer :: ierr
#ifdef _QMX_
  tmp(1) = arg
  call qmx_bcast_dcmplx(1,tmp,ids)
  arg = tmp(1)
#else
  call MPI_BCAST(arg,1,MPI_COMPLEX16,ids,MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
arg :integer, intent(inout)
ids :integer, intent(in)

[Source]

subroutine comlib_bcast_i4(arg,ids)
  implicit none
  integer, intent(inout) :: arg
  integer, intent(in) :: ids
  integer :: ierr,tmp(1)
#ifdef _QMX_
  tmp(1) = arg
  call qmx_bcast_int(1,tmp,ids)
  arg = tmp(1)
#else
  call MPI_BCAST(arg,1,MPI_INTEGER,ids,MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
arg :real(DP), intent(inout)
ids :integer, intent(in)

[Source]

subroutine comlib_bcast_r8(arg,ids)
  implicit none
  real(DP), intent(inout) :: arg
  integer, intent(in) :: ids
  real(DP) :: tmp(1)
  integer :: ierr
#ifdef _QMX_
  tmp(1) = arg
  call qmx_bcast_double(1,tmp,ids)
  arg = tmp(1)
#else
  call MPI_BCAST(arg,1,MPI_REAL8,ids,MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
arg(:) :complex(DP), intent(inout)
ids :integer, intent(in)

[Source]

subroutine comlib_bcast_c16_array(arg,ids)
  implicit none
  complex(DP), intent(inout) :: arg(:)
  integer, intent(in) :: ids
  integer :: ilen,ierr
  ilen=SIZE(arg)
#ifdef _QMX_
  call qmx_bcast_dcmplx(ilen,arg,ids)
#else
  call MPI_BCAST(arg,ilen,MPI_COMPLEX16,ids,MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
arg(:) :integer, intent(inout)
ids :integer, intent(in)

[Source]

subroutine comlib_bcast_i4_array(arg,ids)
  implicit none
  integer, intent(inout) :: arg(:)
  integer, intent(in) :: ids
  integer :: ilen,ierr
  ilen=SIZE(arg)
#ifdef _QMX_
  call qmx_bcast_int(ilen,arg,ids)
#else
  call MPI_BCAST(arg,ilen,MPI_INTEGER,ids,MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
arg(:) :real(DP), intent(inout)
ids :integer, intent(in)

[Source]

subroutine comlib_bcast_r8_array(arg,ids)
  implicit none
  real(DP), intent(inout) :: arg(:)
  integer, intent(in) :: ids
  integer :: ilen,ierr
  ilen=SIZE(arg)
#ifdef _QMX_
  call qmx_bcast_double(ilen,arg,ids)
#else
  call MPI_BCAST(arg,ilen,MPI_REAL8,ids,MPI_COMM_WORLD,ierr)
#endif
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(inout)

[Source]

subroutine comlib_check(id)
  implicit none
  type(comlib_data), intent(inout) :: id
#ifndef _QMX_
  integer :: status(MPI_STATUS_SIZE),ierr
#endif
  if (.not.id%is_initialized) then
    write(*,'("COMLIB_DATA is no initialized.")')
    call comlib_finalize
    stop
  endif
#ifdef _QMX_
  write(*,*)"no implementation for qmx_check"
  call qmx_finalize()
#else
  id%etime0 = local_timer()
  call MPI_Wait(id%rreq,status,ierr)
  id%etime1 = local_timer()
  id%recv_etime = id%recv_etime + (id%etime1-id%etime0)
  id%etime0 = local_timer()
  call MPI_Wait(id%sreq,status,ierr)
  id%etime1 = local_timer()
  id%send_etime = id%send_etime + (id%etime1-id%etime0)
#endif
  return
end subroutine
comlib_data
Derived Type :
name = "" :character(len=CHARLEN), public

communication tag

Subroutine :

[Source]

subroutine comlib_finalize
  implicit none
  integer :: ierr
#ifdef _QMX_
  call qmx_finalize()
#else
  call MPI_Finalize(ierr)
#endif
  m_is_initialized = .false.
  return
end subroutine
Subroutine :

initalize communication library/environment

[Source]

subroutine comlib_init
!
! initalize communication library/environment
!
  use mpi
  implicit none
  integer :: ierr

  if (m_is_initialized) return

  m_num_tags = 0

#ifdef _QMX_

  call qmx_init()
  m_my_rank = qmx_get_local_rank()
  m_num_procs = qmx_get_rank_size()

#else

  call MPI_INIT(ierr)
  call MPI_COMM_RANK(MPI_COMM_WORLD,m_my_rank,ierr)
  call MPI_COMM_SIZE(MPI_COMM_WORLD,m_num_procs,ierr)

#endif

  m_is_initialized = .true.

  return
end subroutine
Subroutine :
id :type(comlib_data), intent(inout)

[Source]

subroutine comlib_irecv(id)
  implicit none
  type(comlib_data), intent(inout) :: id
  integer :: ierr
  if (.not.id%is_initialized) then
    write(*,'("COMLIB_DATA is no initialized.")')
    call comlib_finalize
    stop
  endif
  id%etime0 = local_timer()
#ifdef _QMX_
  write(*,*)"no implementation for qmx_irecv"
  call qmx_finalize()
#else
  if (associated(id%zrecv_buff)) then
    call MPI_Irecv(id%zrecv_buff,id%rsize,MPI_COMPLEX16,id%rdesc,id%rtag, MPI_COMM_WORLD,id%rreq,ierr)
    id%rdata_size = id%rdata_size + id%ssize*16
  else if (associated(id%crecv_buff)) then
    call MPI_Irecv(id%crecv_buff,id%rsize,MPI_COMPLEX8 ,id%rdesc,id%rtag, MPI_COMM_WORLD,id%rreq,ierr)
    id%rdata_size = id%rdata_size + id%ssize*8
  endif
#endif
  id%etime1 = local_timer()
  id%recv_etime = id%recv_etime + (id%etime1-id%etime0)
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(inout)

[Source]

subroutine comlib_isend(id)
  implicit none
  type(comlib_data), intent(inout) :: id
  integer :: ierr
  if (.not.id%is_initialized) then
    write(*,'("COMLIB_DATA is no initialized.")')
    call comlib_finalize
    stop
  endif
  id%etime0 = local_timer()
  id%count = id%count + 1 
#ifdef _QMX_
  write(*,*)"no implementation for qmx_irsend"
  call qmx_finalize()
#else
  if (associated(id%zsend_buff)) then
    call MPI_Irsend(id%zsend_buff,id%ssize,MPI_COMPLEX16,id%sdesc,id%stag, MPI_COMM_WORLD,id%sreq,ierr)
    id%sdata_size = id%sdata_size + id%ssize*16
  else if (associated(id%csend_buff)) then
    call MPI_Irsend(id%csend_buff,id%ssize,MPI_COMPLEX8 ,id%sdesc,id%stag, MPI_COMM_WORLD,id%sreq,ierr)
    id%sdata_size = id%sdata_size + id%ssize*8
  endif
#endif
  id%etime1 = local_timer()
  id%send_etime = id%send_etime + (id%etime1-id%etime0)
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(out)
destination_node :integer, intent(in)
send_buff(:) :complex(DP), target, intent(in)
: data to be send
recv_buff(:) :complex(DP), target, intent(in)
: buffer for received data
send_recv_size :integer, intent(in)
: data array length to be send/received

construct message tag

[Source]

subroutine comlib_make2_dcmplx(id,destination_node,send_buff,recv_buff,send_recv_size)
!
! construct message tag
!
  implicit none
  type(comlib_data),   intent(out):: id
  integer,             intent(in) :: destination_node
  complex(DP), target, intent(in) :: send_buff(:)    ! data to be send
  complex(DP), target, intent(in) :: recv_buff(:)    ! buffer for received data
  integer,             intent(in) :: send_recv_size  ! data array length to be send/received
  if (.not.m_is_initialized) call comlib_init()
  call comlib_set_destination_node(id,destination_node)
  call comlib_set_buffer(id,send_buff,recv_buff,send_recv_size)
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(out)
destination_node :integer, intent(in)
send_buff(:) :complex(SP), target, intent(in)
: data to be send
recv_buff(:) :complex(SP), target, intent(in)
: buffer for received data
send_recv_size :integer, intent(in)
: data array length to be send/received

construct message tag

[Source]

subroutine comlib_make2_cmplx(id,destination_node,send_buff,recv_buff,send_recv_size)
!
! construct message tag
!
  implicit none
  type(comlib_data),   intent(out):: id
  integer,             intent(in) :: destination_node
  complex(SP), target, intent(in) :: send_buff(:)    ! data to be send
  complex(SP), target, intent(in) :: recv_buff(:)    ! buffer for received data
  integer,             intent(in) :: send_recv_size  ! data array length to be send/received
  if (.not.m_is_initialized) call comlib_init()
  call comlib_set_destination_node(id,destination_node)
  call comlib_set_buffer(id,send_buff,recv_buff,send_recv_size)
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(out)
destination_node :integer, intent(in)
send_buff(:) :real(DP), target, intent(in)
: data to be send
recv_buff(:) :real(DP), target, intent(in)
: buffer for received data
send_recv_size :integer, intent(in)
: data array length to be send/received

construct message tag

[Source]

subroutine comlib_make2_double(id,destination_node,send_buff,recv_buff,send_recv_size)
!
! construct message tag
!
  implicit none
  type(comlib_data),   intent(out):: id
  integer,             intent(in) :: destination_node
  real(DP),    target, intent(in) :: send_buff(:)    ! data to be send
  real(DP),    target, intent(in) :: recv_buff(:)    ! buffer for received data
  integer,             intent(in) :: send_recv_size  ! data array length to be send/received
  if (.not.m_is_initialized) call comlib_init()
  call comlib_set_destination_node(id,destination_node)
  call comlib_set_buffer(id,send_buff,recv_buff,send_recv_size)
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(out)
destination_node :integer, intent(in)
send_buff(:) :real(SP), target, intent(in)
: data to be send
recv_buff(:) :real(SP), target, intent(in)
: buffer for received data
send_recv_size :integer, intent(in)
: data array length to be send/received

construct message tag

[Source]

subroutine comlib_make2_single(id,destination_node,send_buff,recv_buff,send_recv_size)
!
! construct message tag
!
  implicit none
  type(comlib_data),   intent(out):: id
  integer,             intent(in) :: destination_node
  real(SP),    target, intent(in) :: send_buff(:)    ! data to be send
  real(SP),    target, intent(in) :: recv_buff(:)    ! buffer for received data
  integer,             intent(in) :: send_recv_size  ! data array length to be send/received
  if (.not.m_is_initialized) call comlib_init()
  call comlib_set_destination_node(id,destination_node)
  call comlib_set_buffer(id,send_buff,recv_buff,send_recv_size)
  return
end subroutine
Subroutine :
nodeid :integer, intent(out)
npe :integer, intent(out)

[Source]

subroutine comlib_node(nodeid,npe)
  implicit none
  integer, intent(out) :: nodeid,npe
  if (.not.m_is_initialized) call comlib_init()
  nodeid = m_my_rank
  npe    = m_num_procs
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(inout)

[Source]

subroutine comlib_print_statistics(id)
  implicit none
  type(comlib_data), intent(inout) :: id
  if (id%is_initialized) then
    write(*,'(2X,A,2X,":")',advance='no')TRIM(id%name)
    write(*,'(1X,"Called=",I10)',  advance='no') get_call_count(id)
    write(*,'(1X,"Etime(sec)=",F10.4)',advance='no') get_etime(id)
    write(*,'(1X,"SendSize(MiB)=",F10.4)',advance='no') get_send_size(id)
    write(*,'(1X,"BandWidth(MiB/sec)=",F10.4)') get_bandwidth(id)
  endif
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(inout)

[Source]

subroutine comlib_sendrecv(id)
  implicit none
  type(comlib_data), intent(inout) :: id
#ifndef _QMX_
  integer :: status(MPI_STATUS_SIZE),ierr
#endif
  if (.not.id%is_initialized) then
    write(*,'("COMLIB_DATA is no initialized.")')
    call comlib_finalize
    stop
  endif
  id%etime0 = local_timer()
  id%count = id%count + 1 
  if (associated(id%zsend_buff)) then
#ifdef _QMX_
  call qmx_sendrecv_dcmplx(id%ssize,id%zsend_buff,id%sdesc,id%zrecv_buff,id%rdesc)
#else
    call MPI_Sendrecv(id%zsend_buff,id%ssize,MPI_COMPLEX16,id%sdesc,id%stag, id%zrecv_buff,id%rsize,MPI_COMPLEX16,id%rdesc,id%rtag, MPI_COMM_WORLD,status,ierr)
#endif
    id%sdata_size = id%sdata_size + id%ssize*16
    id%rdata_size = id%rdata_size + id%rsize*16
  else if (associated(id%csend_buff)) then
#ifdef _QMX_
    call qmx_sendrecv_cmplx(id%ssize,id%csend_buff,id%sdesc,id%crecv_buff,id%rdesc)
#else
    call MPI_Sendrecv(id%csend_buff,id%ssize,MPI_COMPLEX8,id%sdesc,id%stag, id%crecv_buff,id%rsize,MPI_COMPLEX8,id%rdesc,id%rtag, MPI_COMM_WORLD,status,ierr)
#endif
    id%sdata_size = id%sdata_size + id%ssize*16
    id%rdata_size = id%rdata_size + id%rsize*16
  endif
  id%etime1 = local_timer()
  id%send_etime = id%send_etime + (id%etime1-id%etime0)
  id%recv_etime = id%recv_etime + (id%etime1-id%etime0)
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(inout)
send(:) :complex(DP), target, intent(in)
recv(:) :complex(DP), target, intent(in)
isize :integer, intent(in)
: array length

set send data and reciv buffer and data size

[Source]

subroutine comlib_set_buffer_dcmplx(id,send,recv,isize)
!
! set send data and reciv buffer and data size
!
  implicit none
  type(comlib_data),   intent(inout):: id
  complex(DP), target, intent(in)   :: send(:),recv(:)
  integer,             intent(in)   :: isize   ! array length

  if (.not.m_is_initialized) call comlib_init()

  if (.not.id%is_initialized) then
    write(*,'("COMLIB_DATA ERROR: set destination befor set buffer.")')
    call comlib_finalize
    stop
  endif
  id%ssize = isize             ! amount of data in byte (send)
  id%rsize = isize             ! amount of data in byte (recv)
  id%zsend_buff => send        ! send buffer (pointer)
  id%zrecv_buff => recv        ! receive buffer (pointer)
  id%zsend_buff(:) = Z0
  id%zrecv_buff(:) = Z0
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(inout)
send(:) :complex(SP), target, intent(in)
recv(:) :complex(SP), target, intent(in)
isize :integer, intent(in)
: array length

set send data and reciv buffer and data size

[Source]

subroutine comlib_set_buffer_cmplx(id,send,recv,isize)
!
! set send data and reciv buffer and data size
!
  implicit none
  type(comlib_data),   intent(inout):: id
  complex(SP), target, intent(in)   :: send(:),recv(:)
  integer,             intent(in)   :: isize   ! array length

  if (.not.m_is_initialized) call comlib_init()

  if (.not.id%is_initialized) then
    write(*,'("COMLIB_DATA ERROR: set destination befor set buffer.")')
    call comlib_finalize
    stop
  endif
  id%ssize = isize             ! amount of data in byte (send)
  id%rsize = isize             ! amount of data in byte (recv)
  id%csend_buff => send        ! send buffer (pointer)
  id%crecv_buff => recv        ! receive buffer (pointer)
  id%csend_buff(:) = C0
  id%crecv_buff(:) = C0
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(inout)
send(:) :real(DP), target, intent(in)
recv(:) :real(DP), target, intent(in)
isize :integer, intent(in)
: array length

set send data and reciv buffer and data size

[Source]

subroutine comlib_set_buffer_double(id,send,recv,isize)
!
! set send data and reciv buffer and data size
!
  implicit none
  type(comlib_data),   intent(inout):: id
  real(DP),    target, intent(in)   :: send(:),recv(:)
  integer,             intent(in)   :: isize   ! array length

  if (.not.m_is_initialized) call comlib_init()

  if (.not.id%is_initialized) then
    write(*,'("COMLIB_DATA ERROR: set destination befor set buffer.")')
    call comlib_finalize
    stop
  endif
  id%ssize = isize             ! amount of data in byte (send)
  id%rsize = isize             ! amount of data in byte (recv)
  id%dsend_buff => send        ! send buffer (pointer)
  id%drecv_buff => recv        ! receive buffer (pointer)
  id%dsend_buff(:) = 0.0_DP
  id%drecv_buff(:) = 0.0_DP
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(inout)
send(:) :real(SP), target, intent(in)
recv(:) :real(SP), target, intent(in)
isize :integer, intent(in)
: array length

set send data and reciv buffer and data size

[Source]

subroutine comlib_set_buffer_single(id,send,recv,isize)
!
! set send data and reciv buffer and data size
!
  implicit none
  type(comlib_data),   intent(inout):: id
  real(SP),    target, intent(in)   :: send(:),recv(:)
  integer,             intent(in)   :: isize   ! array length

  if (.not.m_is_initialized) call comlib_init()

  if (.not.id%is_initialized) then
    write(*,'("COMLIB_DATA ERROR: set destination befor set buffer.")')
    call comlib_finalize
    stop
  endif
  id%ssize = isize             ! amount of data in byte (send)
  id%rsize = isize             ! amount of data in byte (recv)
  id%ssend_buff => send        ! send buffer (pointer)
  id%srecv_buff => recv        ! receive buffer (pointer)
  id%ssend_buff(:) = 0.0_SP
  id%srecv_buff(:) = 0.0_SP
  return
end subroutine
Subroutine :
id :type(comlib_data), intent(inout)
destination_node :integer, intent(in)

set destination node

[Source]

subroutine comlib_set_destination_node(id,destination_node)
!
! set destination node
!
  implicit none
  type(comlib_data),   intent(inout):: id
  integer,             intent(in)   :: destination_node

  type(comlib_data) :: idall(0:m_num_procs-1)
  integer :: ierr,i,itmp(1)

  if (.not.m_is_initialized) call comlib_init()

  idall(m_my_rank)%sdesc = destination_node  ! send : my_rank -> node

  !==========================================
  ! make send receive table for all nodes
  !==========================================
  do i=0,m_num_procs-1
#ifdef _QMX_
    itmp(1) = idall(i)%sdesc
    call qmx_bcast_int(1,itmp,i)
    idall(i)%sdesc = itmp(1)
#else
    call MPI_BCAST(idall(i)%sdesc,1,MPI_INTEGER,i,MPI_COMM_WORLD,ierr)
#endif
  enddo

  do i=0,m_num_procs-1
    idall(idall(i)%sdesc)%rdesc = i
  enddo

  do i=0,m_num_procs-1
    m_num_tags = m_num_tags + 1
    idall(i)%stag = m_num_tags
  enddo

  do i=0,m_num_procs-1
    idall(i)%rtag = idall(idall(i)%rdesc)%stag
  enddo

  id%sdesc = idall(m_my_rank)%sdesc ! node number (send)
  id%rdesc = idall(m_my_rank)%rdesc ! node number (recv)
  id%stag  = idall(m_my_rank)%stag  ! tag (send)
  id%rtag  = idall(m_my_rank)%rtag  ! tag (recv)

  id%is_initialized = .TRUE.

  return
end subroutine
Subroutine :
c16 :complex(DP), intent(inout)

[Source]

subroutine comlib_sumcast_c16(c16)
  implicit none
  complex(DP), intent(inout) :: c16
  complex(DP) :: c16tmp,tmp(1)
  integer :: ierr
#ifdef _QMX_
  tmp(1) = c16
  call qmx_sumcast_dcmplx(1,tmp)
  c16 = tmp(1)
#else
  call MPI_Allreduce(c16,c16tmp,1,MPI_COMPLEX16, MPI_SUM,MPI_COMM_WORLD,ierr)
  c16=c16tmp
#endif
  return
end subroutine
Subroutine :
c16(:) :complex(DP), intent(inout)

[Source]

subroutine comlib_sumcast_c16_array(c16)
  implicit none
  complex(DP), intent(inout) :: c16(:)
  complex(DP) :: c16tmp(SIZE(c16))
  integer :: ierr,isize
  isize=SIZE(c16)
#ifdef _QMX_
  call qmx_sumcast_dcmplx(isize,c16)
#else
  call MPI_Allreduce(c16,c16tmp,isize,MPI_COMPLEX16, MPI_SUM,MPI_COMM_WORLD,ierr)
  c16(:) = c16tmp(:)
#endif
  return
end subroutine
Subroutine :
c8 :complex(SP), intent(inout)

[Source]

subroutine comlib_sumcast_c8(c8)
  implicit none
  complex(SP), intent(inout) :: c8
  complex(SP) :: c8tmp,tmp(1)
  integer :: ierr
#ifdef _QMX_
  tmp(1) = c8
  call qmx_sumcast_cmplx(1,tmp)
  c8 = tmp(1)
#else
  call MPI_Allreduce(c8,c8tmp,1,MPI_COMPLEX8, MPI_SUM,MPI_COMM_WORLD,ierr)
  c8=c8tmp
#endif
  return
end subroutine
Subroutine :
c8(:) :complex(SP), intent(inout)

[Source]

subroutine comlib_sumcast_c8_array(c8)
  implicit none
  complex(SP), intent(inout) :: c8(:)
  complex(SP) :: c8tmp(SIZE(c8))
  integer :: ierr,isize
  isize=SIZE(c8)
#ifdef _QMX_
  call qmx_sumcast_cmplx(isize,c8)
#else
  call MPI_Allreduce(c8,c8tmp,isize,MPI_COMPLEX8, MPI_SUM,MPI_COMM_WORLD,ierr)
  c8(:) = c8tmp(:)
#endif
  return
end subroutine
Subroutine :
i4 :integer, intent(inout)

[Source]

subroutine comlib_sumcast_i4(i4)
  implicit none
  integer, intent(inout) :: i4
  integer :: i4tmp,tmp(1)
  integer :: ierr
#ifdef _QMX_
  tmp(1) = i4
  call qmx_sumcast_int(1,tmp)
  i4 = tmp(1)
#else
  call MPI_Allreduce(i4,i4tmp,1,MPI_INTEGER, MPI_SUM,MPI_COMM_WORLD,ierr)
  i4=i4tmp
#endif
  return
end subroutine
Subroutine :
i4(:) :integer, intent(inout)

[Source]

subroutine comlib_sumcast_i4_array(i4)
  implicit none
  integer, intent(inout) :: i4(:)
  integer :: i4tmp(SIZE(i4))
  integer :: ierr,isize
  isize=SIZE(i4)
#ifdef _QMX_
  call qmx_sumcast_int(isize,i4)
#else
  call MPI_Allreduce(i4,i4tmp,isize,MPI_INTEGER, MPI_SUM,MPI_COMM_WORLD,ierr)
  i4=i4tmp
#endif
  return
end subroutine
Subroutine :
r4 :real(SP), intent(inout)

[Source]

subroutine comlib_sumcast_r4(r4)
  implicit none
  real(SP), intent(inout) :: r4
  real(SP) :: r4tmp,tmp(1)
  integer :: ierr
#ifdef _QMX_
  tmp(1) = r4
  call qmx_sumcast_float(1,tmp)
  r4 = tmp(1)
#else
  call MPI_Allreduce(r4,r4tmp,1,MPI_REAL4, MPI_SUM,MPI_COMM_WORLD,ierr)
  r4=r4tmp
#endif
  return
end subroutine
Subroutine :
r4(:) :real(SP), intent(inout)

[Source]

subroutine comlib_sumcast_r4_array(r4)
  implicit none
  real(SP), intent(inout) :: r4(:)
  real(SP) :: r4tmp(SIZE(r4))
  integer :: ierr,isize
  isize=SIZE(r4)
#ifdef _QMX_
  call qmx_sumcast_float(isize,r4)
#else
  call MPI_Allreduce(r4,r4tmp,isize,MPI_REAL4, MPI_SUM,MPI_COMM_WORLD,ierr)
  r4=r4tmp
#endif
  return
end subroutine
Subroutine :
r8 :real(DP), intent(inout)

[Source]

subroutine comlib_sumcast_r8(r8)
  implicit none
  real(DP), intent(inout) :: r8
  real(DP) :: r8tmp,tmp(1)
  integer :: ierr
#ifdef _QMX_
  tmp(1) = r8
  call qmx_sumcast_double(1,tmp)
  r8 = tmp(1)
#else
  call MPI_Allreduce(r8,r8tmp,1,MPI_REAL8, MPI_SUM,MPI_COMM_WORLD,ierr)
  r8=r8tmp
#endif
  return
end subroutine
Subroutine :
r8(:) :real(DP), intent(inout)

[Source]

subroutine comlib_sumcast_r8_array(r8)
  implicit none
  real(DP), intent(inout) :: r8(:)
  real(DP) :: r8tmp(SIZE(r8))
  integer :: ierr,isize
  isize=SIZE(r8)
#ifdef _QMX_
  call qmx_sumcast_double(isize,r8)
#else
  call MPI_Allreduce(r8,r8tmp,isize,MPI_REAL8, MPI_SUM,MPI_COMM_WORLD,ierr)
  r8=r8tmp
#endif
  return
end subroutine
Function :
bw :real(DP)
id :type(comlib_data), intent(inout)

[Source]

function get_bandwidth(id) result(bw)
  implicit none
  type(comlib_data), intent(inout) :: id
  real(DP) :: bw
  if (id%send_etime > 0) then
    bw = (id%sdata_size/id%send_etime)/1024_DP/1024_DP
  else
    bw = 0.0_DP
  endif
  return
end function
Function :
count :integer
id :type(comlib_data), intent(inout)

[Source]

function get_call_count(id) result(count)
  implicit none
  type(comlib_data), intent(inout) :: id
  integer :: count
  count = id%count
  return
end function
Function :
time :real(DP)
id :type(comlib_data), intent(inout)

[Source]

function get_etime(id) result(time)
  implicit none
  type(comlib_data), intent(inout) :: id
  real(DP) :: time
  time = id%send_etime
  return
end function
Function :
ssize :real(DP)
id :type(comlib_data), intent(inout)

[Source]

function get_send_size(id) result(ssize)
  implicit none
  type(comlib_data), intent(inout) :: id
  real(DP) :: ssize
  ssize = id%sdata_size/1024_DP/1024_DP
  return
end function