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