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