18980d4a7Sjeremylt!----------------------------------------------------------------------- 28980d4a7Sjeremylt program test 38980d4a7Sjeremylt 48980d4a7Sjeremylt include 'ceedf.h' 58980d4a7Sjeremylt 68980d4a7Sjeremylt integer ceed,err 78980d4a7Sjeremylt integer x,y 88980d4a7Sjeremylt integer r 98980d4a7Sjeremylt integer i 10c8b9fe72Sjeremylt integer*8 aoffset,yoffset 118980d4a7Sjeremylt 128980d4a7Sjeremylt integer ne 138980d4a7Sjeremylt parameter(ne=3) 14*a8d32208Sjeremylt integer lmode 15*a8d32208Sjeremylt parameter(lmode=ceed_notranspose) 168980d4a7Sjeremylt 178980d4a7Sjeremylt integer*4 ind(2*ne) 188980d4a7Sjeremylt real*8 a(ne+1) 198980d4a7Sjeremylt real*8 yy(2*ne) 208980d4a7Sjeremylt real*8 diff 218980d4a7Sjeremylt 228980d4a7Sjeremylt character arg*32 238980d4a7Sjeremylt 248980d4a7Sjeremylt call getarg(1,arg) 258980d4a7Sjeremylt call ceedinit(trim(arg)//char(0),ceed,err) 268980d4a7Sjeremylt 278980d4a7Sjeremylt call ceedvectorcreate(ceed,ne+1,x,err) 288980d4a7Sjeremylt 298980d4a7Sjeremylt do i=1,ne+1 308980d4a7Sjeremylt a(i)=10+i-1 318980d4a7Sjeremylt enddo 328980d4a7Sjeremylt 33c8b9fe72Sjeremylt aoffset=0 34c8b9fe72Sjeremylt call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err) 358980d4a7Sjeremylt 368980d4a7Sjeremylt do i=1,ne 378980d4a7Sjeremylt ind(2*i-1)=i-1 388980d4a7Sjeremylt ind(2*i )=i 398980d4a7Sjeremylt enddo 408980d4a7Sjeremylt 41*a8d32208Sjeremylt call ceedelemrestrictioncreate(ceed,lmode,ne,2,ne+1,1,ceed_mem_host,& 428980d4a7Sjeremylt & ceed_use_pointer,ind,r,err) 438980d4a7Sjeremylt 448980d4a7Sjeremylt call ceedvectorcreate(ceed,2*ne,y,err); 458980d4a7Sjeremylt call ceedvectorsetvalue(y,0.d0,err); 46*a8d32208Sjeremylt call ceedelemrestrictionapply(r,ceed_notranspose,x,y,& 478980d4a7Sjeremylt & ceed_request_immediate,err) 488980d4a7Sjeremylt 49c8b9fe72Sjeremylt call ceedvectorgetarrayread(y,ceed_mem_host,yy,yoffset,err) 508980d4a7Sjeremylt do i=1,ne*2 51c8b9fe72Sjeremylt diff=10+i/2-yy(i+yoffset) 528980d4a7Sjeremylt if (abs(diff) > 1.0D-15) then 53a2546046Sjeremylt! LCOV_EXCL_START 54c8b9fe72Sjeremylt write(*,*) 'Error in restricted array y(',i,')=',yy(i+yoffset) 55de996c55Sjeremylt! LCOV_EXCL_STOP 568980d4a7Sjeremylt endif 578980d4a7Sjeremylt enddo 58c8b9fe72Sjeremylt call ceedvectorrestorearrayread(y,yy,yoffset,err) 598980d4a7Sjeremylt 608980d4a7Sjeremylt call ceedvectordestroy(x,err) 618980d4a7Sjeremylt call ceedvectordestroy(y,err) 628980d4a7Sjeremylt call ceedelemrestrictiondestroy(r,err) 638980d4a7Sjeremylt call ceeddestroy(ceed,err) 648980d4a7Sjeremylt 658980d4a7Sjeremylt end 668980d4a7Sjeremylt!----------------------------------------------------------------------- 67