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,blksize*elemsize,y,err); 45 call ceedvectorsetvalue(y,0.d0,err) 46 47! No Transpose 48 call ceedelemrestrictionapplyblock(r,1,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=blksize,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 & blksize*elemsize 59 diff=yy(yoffset+indx+1) 60 diff=diff-a(ind(k*elemsize+i+1)+1) 61 if (abs(diff) > 1.0D-15) then 62! LCOV_EXCL_START 63 write(*,*) 'Error in restricted array y(',i,')(',j,')(',k,')=',& 64 & yy(yoffset+indx+1) 65! LCOV_EXCL_STOP 66 endif 67 enddo 68 enddo 69 enddo 70 call ceedvectorrestorearrayread(y,yy,yoffset,err) 71 72! Transpose 73 call ceedvectorsetvalue(x,0.d0,err) 74 call ceedelemrestrictionapplyblock(r,1,ceed_transpose,y,x,& 75 & ceed_request_immediate,err) 76 call ceedvectorgetarrayread(x,ceed_mem_host,xx,xoffset,err) 77 do i=blksize+1,ne+1 78 diff=xx(xoffset+i) 79 if (i > blksize+1 .and. i < ne+1) then 80 diff=diff-2*(10+i-1) 81 else 82 diff=diff-(10+i-1) 83 endif 84 if (abs(diff) > 1.0D-15) then 85! LCOV_EXCL_START 86 write(*,*) 'Error in restricted array x(',i,')=',& 87 & xx(xoffset+i) 88! LCOV_EXCL_STOP 89 endif 90 enddo 91 call ceedvectorrestorearrayread(x,xx,xoffset,err) 92 93 call ceedvectordestroy(x,err) 94 call ceedvectordestroy(y,err) 95 call ceedelemrestrictiondestroy(r,err) 96 call ceeddestroy(ceed,err) 97 98 end 99!----------------------------------------------------------------------- 100