18980d4a7Sjeremylt!----------------------------------------------------------------------- 28980d4a7Sjeremylt program test 31f9a83abSJed Brown implicit none 4ec3da8bcSJed Brown include 'ceed/fortran.h' 58980d4a7Sjeremylt 68980d4a7Sjeremylt integer ceed,err 78980d4a7Sjeremylt integer x,y 8*0acb07cdSJeremy L Thompson integer r 9*0acb07cdSJeremy L Thompson integer i,j,k 108980d4a7Sjeremylt 11*0acb07cdSJeremy L Thompson integer ne,elemsize,nb,blksize 12*0acb07cdSJeremy L Thompson parameter(ne=8,elemsize=2,nb=2,blksize=5) 13*0acb07cdSJeremy L Thompson integer ind(elemsize*ne) 14*0acb07cdSJeremy L Thompson integer layout(3) 15*0acb07cdSJeremy L Thompson integer blk,elem,indx 168980d4a7Sjeremylt 178980d4a7Sjeremylt real*8 a(ne+1) 18*0acb07cdSJeremy L Thompson real*8 yy(nb*blksize*elemsize) 19*0acb07cdSJeremy L Thompson real*8 xx(ne+1) 20*0acb07cdSJeremy L Thompson real*8 diff 21*0acb07cdSJeremy L Thompson integer*8 aoffset,xoffset,yoffset 228980d4a7Sjeremylt 238980d4a7Sjeremylt character arg*32 248980d4a7Sjeremylt 258980d4a7Sjeremylt call getarg(1,arg) 268980d4a7Sjeremylt call ceedinit(trim(arg)//char(0),ceed,err) 278980d4a7Sjeremylt 288980d4a7Sjeremylt call ceedvectorcreate(ceed,ne+1,x,err) 298980d4a7Sjeremylt 308980d4a7Sjeremylt do i=1,ne+1 318980d4a7Sjeremylt a(i)=10+i-1 328980d4a7Sjeremylt enddo 338980d4a7Sjeremylt 34c8b9fe72Sjeremylt aoffset=0 35c8b9fe72Sjeremylt call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err) 368980d4a7Sjeremylt 378980d4a7Sjeremylt do i=1,ne 388980d4a7Sjeremylt ind(2*i-1)=i-1 398980d4a7Sjeremylt ind(2*i )=i 408980d4a7Sjeremylt enddo 41*0acb07cdSJeremy L Thompson call ceedelemrestrictioncreateblocked(ceed,ne,elemsize,blksize,1,1,ne+1,& 428980d4a7Sjeremylt & ceed_mem_host,ceed_use_pointer,ind,r,err) 438980d4a7Sjeremylt 44*0acb07cdSJeremy L Thompson call ceedvectorcreate(ceed,nb*blksize*elemsize,y,err); 45*0acb07cdSJeremy L Thompson call ceedvectorsetvalue(y,0.d0,err) 468980d4a7Sjeremylt 478980d4a7Sjeremylt! NoTranspose 48a8d32208Sjeremylt call ceedelemrestrictionapply(r,ceed_notranspose,x,y,& 498980d4a7Sjeremylt & ceed_request_immediate,err) 50*0acb07cdSJeremy L Thompson call ceedvectorgetarrayread(y,ceed_mem_host,yy,yoffset,err) 51*0acb07cdSJeremy L Thompson call ceedelemrestrictiongetelayout(r,layout,err) 52*0acb07cdSJeremy L Thompson do i=0,elemsize-1 53*0acb07cdSJeremy L Thompson do j=0,0 54*0acb07cdSJeremy L Thompson do k=0,ne-1 55*0acb07cdSJeremy L Thompson blk = k/blksize 56*0acb07cdSJeremy L Thompson elem = mod(k,blksize) 57*0acb07cdSJeremy L Thompson indx = (i*blksize+elem)*layout(1)+j*layout(2)*blksize+blk*layout(3)*blksize 58*0acb07cdSJeremy L Thompson diff=yy(yoffset+indx+1) 59*0acb07cdSJeremy L Thompson diff=diff-a(ind(k*elemsize+i+1)+1) 60*0acb07cdSJeremy L Thompson if (abs(diff) > 1.0D-15) then 61*0acb07cdSJeremy L Thompson! LCOV_EXCL_START 62*0acb07cdSJeremy L Thompson write(*,*) 'Error in restricted array y(',i,')(',j,')(',k,')=',& 63*0acb07cdSJeremy L Thompson & yy(yoffset+indx+1) 64*0acb07cdSJeremy L Thompson! LCOV_EXCL_STOP 65*0acb07cdSJeremy L Thompson endif 66*0acb07cdSJeremy L Thompson enddo 67*0acb07cdSJeremy L Thompson enddo 68*0acb07cdSJeremy L Thompson enddo 69*0acb07cdSJeremy L Thompson call ceedvectorrestorearrayread(y,yy,yoffset,err) 708980d4a7Sjeremylt 718980d4a7Sjeremylt! Transpose 72*0acb07cdSJeremy L Thompson call ceedvectorsetvalue(x,0.d0,err) 73a8d32208Sjeremylt call ceedelemrestrictionapply(r,ceed_transpose,y,x,& 748980d4a7Sjeremylt & ceed_request_immediate,err) 75*0acb07cdSJeremy L Thompson call ceedvectorgetarrayread(x,ceed_mem_host,xx,xoffset,err) 76*0acb07cdSJeremy L Thompson do i=1,ne+1 77*0acb07cdSJeremy L Thompson diff=xx(xoffset+i) 78*0acb07cdSJeremy L Thompson if (i > 1 .and. i < ne+1) then 79*0acb07cdSJeremy L Thompson diff=diff-2*(10+i-1) 80*0acb07cdSJeremy L Thompson else 81*0acb07cdSJeremy L Thompson diff=diff-(10+i-1) 82*0acb07cdSJeremy L Thompson endif 83*0acb07cdSJeremy L Thompson if (abs(diff) > 1.0D-15) then 84*0acb07cdSJeremy L Thompson! LCOV_EXCL_START 85*0acb07cdSJeremy L Thompson write(*,*) 'Error in restricted array x(',i,')=',& 86*0acb07cdSJeremy L Thompson & xx(xoffset+i) 87*0acb07cdSJeremy L Thompson! LCOV_EXCL_STOP 88*0acb07cdSJeremy L Thompson endif 89*0acb07cdSJeremy L Thompson enddo 90*0acb07cdSJeremy L Thompson call ceedvectorrestorearrayread(x,xx,xoffset,err) 918980d4a7Sjeremylt 928980d4a7Sjeremylt call ceedvectordestroy(x,err) 938980d4a7Sjeremylt call ceedvectordestroy(y,err) 948980d4a7Sjeremylt call ceedelemrestrictiondestroy(r,err) 958980d4a7Sjeremylt call ceeddestroy(ceed,err) 968980d4a7Sjeremylt 978980d4a7Sjeremylt end 988980d4a7Sjeremylt!----------------------------------------------------------------------- 99