## 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
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
```

Michael L. Hall