DemoCoarrayLineclip.f90

program lineclip

    use, intrinsic:: ieee_arithmetic
    use lineclip,only: Ccohensutherland, cohensutherland
    use assert, only: wp, assert_isclose

    implicit none

    real(wp) :: L(8)[*]

    call coarray_lineclip(L)
!    if(this_image()==1)  print *,L

contains

subroutine coarray_lineclip(length)

    integer, parameter :: Np=8
    real(wp), dimension(Np) :: x1,x2,y1,y2
    real(wp),parameter :: xmin=1., ymax=5.,xmax=4., ymin=3.
    real(wp) :: truelength(Np) =[2.40370083, 3.,0.,0.,0.,0.,2.,2.5]
    real(wp) :: nan
    integer :: Ni, im, s0,s1
    real(wp),intent(out) :: length(Np)[*]

    Ni = num_images()
    im=this_image()

    nan = ieee_value(1.,ieee_quiet_nan)
    truelength(3:6) = nan

    x1=[0.,0.,0.,0.,0.,0.,0.,0.]
    y1=[0.,4.,1.,1.5,2.,2.5,3.0,3.5]
    x2=[4.,5.,1.,1.5,2.,2.5,3.0,3.5]
    y2=[6.,4.,1.,1.5,2.,2.5,3.0,3.5]

!------ slice problem
    s0 = (im-1)*Np/Ni+1
    s1 = im*Np/Ni
    print '(A,I3,A,I3,A,I3)','Image',im,' solved over indices ',s0,':',s1
!------- solve problem
    call cohensutherland(xmin,ymax,xmax,ymin, &
                x1(s0:s1), y1(s0:s1), x2(s0:s1), y2(s0:s1))

    length(s0:s1)[1] = hypot(x2(s0:s1) - x1(s0:s1), y2(s0:s1) - y1(s0:s1))
!-------- finish up
    sync all

    if (im==1) then
        call assert_isclose(length, truelength, equal_nan=.true.)
        print *, 'OK coarray_lineclip'
    endif


end subroutine coarray_lineclip

end program