D.2.14 Communication Class Unit Test Program

This lightly commented program performs a unit test on the Communication Class.

program Unit_Test

  use Caesar_Intrinsics_Module
  use Caesar_Communication_Class
  implicit none

  type(real,1) :: R, R2
  type(real,1) :: R_PE
  type(integer,1) :: Length_PE
  type(integer) :: already_counted, i, index, Length, pe
  type(Communication_type) :: Comm

  ! Initialize communications.

  call Initialize (Comm)
  call Output (Comm)

  ! Set total length and individual lengths of parallel vectors.

  Length = 100
  call Initialize (Length_PE, NPEs)
  ! Unequal setting per PE to trip more possible bugs.
  Length_PE(NPEs) = Length
  do pe = 1, NPEs-1
    Length_PE(pe) = (Length / NPEs) / 2
    Length_PE(NPEs) = Length_PE(NPEs) - Length_PE(pe)
  end do

  ! Initialize assembled and distributed vectors.

  if (this_is_IO_PE) then
    call Initialize (R, Length)
    call Initialize (R2, Length)
  else
    call Initialize (R, 0)
    call Initialize (R2, 0)
  end if
  call Initialize (R_PE, Length_PE(this_PE))

  ! Set the assembled vector.

  if (this_is_IO_PE) then
    R = (/ ( changetype(real, Length - i), i=1,Length ) /)
  end if

  ! Distribute the vector.

  call Distribute (R_PE, R, Length_PE)

  ! Check the distributed vector.

  if (NPEs == 1) then
    already_counted = 0
  else
    already_counted = SUM( Length_PE(1:this_PE-1) )
  end if
  do i = 1, Length_PE(this_PE)
    index = already_counted + i
    if (R_PE(i) /= changetype(real, Length - index) ) then
      write (6,*) 'Error --> ', R_PE(i), R(i), i, Length - index
    end if
  end do

  ! Assemble and check the vector.

  call Assemble (R2, R_PE)
  if (ANY(R2 /= R) .and. this_is_IO_PE) then
    write (6,*) 'Error --> R /= R2'
  end if

  ! Check state of communication.

  VERIFY(Valid_State(Comm),0)

  ! Finalize communications.

  call Finalize (Comm)

end