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,elemsize,nb,blksize 12 parameter(ne=8,elemsize=2,nb=2,blksize=5) 13 integer ind(elemsize*ne) 14 integer layout(3) 15 integer blk,elem,indx 16 17 real*8 a(ne+1) 18 real*8 yy(nb*blksize*elemsize) 19 real*8 xx(ne+1) 20 real*8 diff 21 integer*8 aoffset,xoffset,yoffset 22 23 character arg*32 24 25 call getarg(1,arg) 26 call ceedinit(trim(arg)//char(0),ceed,err) 27 28 call ceedvectorcreate(ceed,ne+1,x,err) 29 30 do i=1,ne+1 31 a(i)=10+i-1 32 enddo 33 34 aoffset=0 35 call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err) 36 37 do i=1,ne 38 ind(2*i-1)=i-1 39 ind(2*i )=i 40 enddo 41 call ceedelemrestrictioncreateblocked(ceed,ne,elemsize,blksize,1,1,ne+1,& 42 & ceed_mem_host,ceed_use_pointer,ind,r,err) 43 44 call ceedvectorcreate(ceed,nb*blksize*elemsize,y,err); 45 call ceedvectorsetvalue(y,0.d0,err) 46 47! NoTranspose 48 call ceedelemrestrictionapply(r,ceed_notranspose,x,y,& 49 & ceed_request_immediate,err) 50 call ceedvectorgetarrayread(y,ceed_mem_host,yy,yoffset,err) 51 call ceedelemrestrictiongetelayout(r,layout,err) 52 do i=0,elemsize-1 53 do j=0,0 54 do k=0,ne-1 55 blk = k/blksize 56 elem = mod(k,blksize) 57 indx = (i*blksize+elem)*layout(1)+j*layout(2)*blksize+blk*layout(3)*blksize 58 diff=yy(yoffset+indx+1) 59 diff=diff-a(ind(k*elemsize+i+1)+1) 60 if (abs(diff) > 1.0D-15) then 61! LCOV_EXCL_START 62 write(*,*) 'Error in restricted array y(',i,')(',j,')(',k,')=',& 63 & yy(yoffset+indx+1) 64! LCOV_EXCL_STOP 65 endif 66 enddo 67 enddo 68 enddo 69 call ceedvectorrestorearrayread(y,yy,yoffset,err) 70 71! Transpose 72 call ceedvectorsetvalue(x,0.d0,err) 73 call ceedelemrestrictionapply(r,ceed_transpose,y,x,& 74 & ceed_request_immediate,err) 75 call ceedvectorgetarrayread(x,ceed_mem_host,xx,xoffset,err) 76 do i=1,ne+1 77 diff=xx(xoffset+i) 78 if (i > 1 .and. i < ne+1) then 79 diff=diff-2*(10+i-1) 80 else 81 diff=diff-(10+i-1) 82 endif 83 if (abs(diff) > 1.0D-15) then 84! LCOV_EXCL_START 85 write(*,*) 'Error in restricted array x(',i,')=',& 86 & xx(xoffset+i) 87! LCOV_EXCL_STOP 88 endif 89 enddo 90 call ceedvectorrestorearrayread(x,xx,xoffset,err) 91 92 call ceedvectordestroy(x,err) 93 call ceedvectordestroy(y,err) 94 call ceedelemrestrictiondestroy(r,err) 95 call ceeddestroy(ceed,err) 96 97 end 98!----------------------------------------------------------------------- 99