1!----------------------------------------------------------------------- 2 program test 3 4 include 'ceedf.h' 5 6 integer ceed,err 7 integer x,y 8 integer r 9 integer i 10 integer*8 aoffset,yoffset 11 12 integer ne 13 parameter(ne=3) 14 integer imode 15 parameter(imode=ceed_noninterlaced) 16 17 integer*4 ind(2*ne) 18 real*8 a(ne+1) 19 real*8 yy(2*ne) 20 real*8 diff 21 22 character arg*32 23 24 call getarg(1,arg) 25 call ceedinit(trim(arg)//char(0),ceed,err) 26 27 call ceedvectorcreate(ceed,ne+1,x,err) 28 29 do i=1,ne+1 30 a(i)=10+i-1 31 enddo 32 33 aoffset=0 34 call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err) 35 36 do i=1,ne 37 ind(2*i-1)=i-1 38 ind(2*i )=i 39 enddo 40 41 call ceedelemrestrictioncreate(ceed,imode,ne,2,ne+1,1,ceed_mem_host,& 42 & ceed_use_pointer,ind,r,err) 43 44 call ceedvectorcreate(ceed,2*ne,y,err); 45 call ceedvectorsetvalue(y,0.d0,err); 46 call ceedelemrestrictionapply(r,ceed_notranspose,x,y,& 47 & ceed_request_immediate,err) 48 49 call ceedvectorgetarrayread(y,ceed_mem_host,yy,yoffset,err) 50 do i=1,ne*2 51 diff=10+i/2-yy(i+yoffset) 52 if (abs(diff) > 1.0D-15) then 53! LCOV_EXCL_START 54 write(*,*) 'Error in restricted array y(',i,')=',yy(i+yoffset) 55! LCOV_EXCL_STOP 56 endif 57 enddo 58 call ceedvectorrestorearrayread(y,yy,yoffset,err) 59 60 call ceedvectordestroy(x,err) 61 call ceedvectordestroy(y,err) 62 call ceedelemrestrictiondestroy(r,err) 63 call ceeddestroy(ceed,err) 64 65 end 66!----------------------------------------------------------------------- 67