18980d4a7Sjeremylt!----------------------------------------------------------------------- 28980d4a7Sjeremylt program test 31f9a83abSJed Brown implicit none 4ec3da8bcSJed Brown include 'ceed/fortran.h' 58980d4a7Sjeremylt 68980d4a7Sjeremylt integer ceed,err 78980d4a7Sjeremylt integer x,y 849fd234cSJeremy L Thompson integer r 949fd234cSJeremy L Thompson integer i,j,k 108980d4a7Sjeremylt 118980d4a7Sjeremylt integer ne 128980d4a7Sjeremylt parameter(ne=3) 137509a596Sjeremylt integer strides(3) 1449fd234cSJeremy L Thompson integer layout(3) 158980d4a7Sjeremylt 168980d4a7Sjeremylt real*8 a(2*ne) 178980d4a7Sjeremylt real*8 yy(2*ne) 188980d4a7Sjeremylt real*8 diff 19c8b9fe72Sjeremylt integer*8 aoffset,yoffset 208980d4a7Sjeremylt 218980d4a7Sjeremylt character arg*32 228980d4a7Sjeremylt 238980d4a7Sjeremylt call getarg(1,arg) 248980d4a7Sjeremylt call ceedinit(trim(arg)//char(0),ceed,err) 258980d4a7Sjeremylt 268980d4a7Sjeremylt call ceedvectorcreate(ceed,2*ne,x,err) 278980d4a7Sjeremylt 288980d4a7Sjeremylt do i=1,2*ne 298980d4a7Sjeremylt a(i)=10+i-1 308980d4a7Sjeremylt enddo 318980d4a7Sjeremylt 32c8b9fe72Sjeremylt aoffset=0 33c8b9fe72Sjeremylt call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err) 348980d4a7Sjeremylt 357509a596Sjeremylt strides=[1,2,2] 36d979a051Sjeremylt call ceedelemrestrictioncreatestrided(ceed,ne,2,1,2*ne,strides,r,err) 378980d4a7Sjeremylt 38*0acb07cdSJeremy L Thompson call ceedvectorcreate(ceed,2*ne,y,err) 39*0acb07cdSJeremy L Thompson call ceedvectorsetvalue(y,0.d0,err) 40a8d32208Sjeremylt call ceedelemrestrictionapply(r,ceed_notranspose,x,y,& 418980d4a7Sjeremylt & ceed_request_immediate,err) 428980d4a7Sjeremylt 438980d4a7Sjeremylt call ceedvectorgetarrayread(y,ceed_mem_host,yy,yoffset,err) 4449fd234cSJeremy L Thompson call ceedelemrestrictiongetelayout(r,layout,err) 4549fd234cSJeremy L Thompson do i=0,1 4649fd234cSJeremy L Thompson do j=0,0 4749fd234cSJeremy L Thompson do k=0,ne-1 4849fd234cSJeremy L Thompson diff=yy(yoffset+i*layout(1)+j*layout(2)+k*layout(3)+1) 4949fd234cSJeremy L Thompson diff=diff-a(i*strides(1)+j*strides(2)+k*strides(3)+1) 508980d4a7Sjeremylt if (abs(diff) > 1.0D-15) then 51a2546046Sjeremylt! LCOV_EXCL_START 5249fd234cSJeremy L Thompson write(*,*) 'Error in restricted array y(',i,')(',j,')(',k,')=',& 5349fd234cSJeremy L Thompson & yy(yoffset+i*layout(1)+j*layout(2)+k*layout(3)+1) 54de996c55Sjeremylt! LCOV_EXCL_STOP 558980d4a7Sjeremylt endif 568980d4a7Sjeremylt enddo 5749fd234cSJeremy L Thompson enddo 5849fd234cSJeremy L Thompson enddo 598980d4a7Sjeremylt call ceedvectorrestorearrayread(y,yy,yoffset,err) 608980d4a7Sjeremylt 618980d4a7Sjeremylt call ceedvectordestroy(x,err) 628980d4a7Sjeremylt call ceedvectordestroy(y,err) 638980d4a7Sjeremylt call ceedelemrestrictiondestroy(r,err) 648980d4a7Sjeremylt call ceeddestroy(ceed,err) 658980d4a7Sjeremylt 668980d4a7Sjeremylt end 678980d4a7Sjeremylt!----------------------------------------------------------------------- 68