Class | comlib |
In: |
LatticeClass/comlib.F90
|
Interface subroutines to MPI
Subroutine : | |
send : | complex(DP), intent(in) |
recv(0:m_num_procs-1) : | complex(DP), intent(inout) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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 : |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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
Subroutine : |
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
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) |
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) |
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)
| ||
recv_buff(:) : | complex(DP), target, intent(in)
| ||
send_recv_size : | integer, intent(in)
|
construct message tag
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)
| ||
recv_buff(:) : | complex(SP), target, intent(in)
| ||
send_recv_size : | integer, intent(in)
|
construct message tag
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)
| ||
recv_buff(:) : | real(DP), target, intent(in)
| ||
send_recv_size : | integer, intent(in)
|
construct message tag
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)
| ||
recv_buff(:) : | real(SP), target, intent(in)
| ||
send_recv_size : | integer, intent(in)
|
construct message tag
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) |
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) |
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) |
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)
|
set send data and reciv buffer and data size
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)
|
set send data and reciv buffer and data size
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)
|
set send data and reciv buffer and data size
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)
|
set send data and reciv buffer and data size
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
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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