1be9261b7Sjeremylt!----------------------------------------------------------------------- 2be9261b7Sjeremylt program test 31f9a83abSJed Brown implicit none 4ec3da8bcSJed Brown include 'ceed/fortran.h' 5be9261b7Sjeremylt 6be9261b7Sjeremylt integer ceed,err 7be9261b7Sjeremylt integer x,y 8*0acb07cdSJeremy L Thompson integer r 9*0acb07cdSJeremy L Thompson integer i,j,k 10be9261b7Sjeremylt 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 16be9261b7Sjeremylt 17be9261b7Sjeremylt 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 22be9261b7Sjeremylt 23be9261b7Sjeremylt character arg*32 24be9261b7Sjeremylt 25be9261b7Sjeremylt call getarg(1,arg) 26be9261b7Sjeremylt call ceedinit(trim(arg)//char(0),ceed,err) 27be9261b7Sjeremylt 28be9261b7Sjeremylt call ceedvectorcreate(ceed,ne+1,x,err) 29be9261b7Sjeremylt 30be9261b7Sjeremylt do i=1,ne+1 31be9261b7Sjeremylt a(i)=10+i-1 32be9261b7Sjeremylt enddo 33be9261b7Sjeremylt 349fbf56acSjeremylt aoffset=0 359fbf56acSjeremylt call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err) 36be9261b7Sjeremylt 37be9261b7Sjeremylt do i=1,ne 38be9261b7Sjeremylt ind(2*i-1)=i-1 39be9261b7Sjeremylt ind(2*i )=i 40be9261b7Sjeremylt enddo 41*0acb07cdSJeremy L Thompson call ceedelemrestrictioncreateblocked(ceed,ne,elemsize,blksize,1,1,ne+1,& 42be9261b7Sjeremylt & ceed_mem_host,ceed_use_pointer,ind,r,err) 43be9261b7Sjeremylt 44*0acb07cdSJeremy L Thompson call ceedvectorcreate(ceed,blksize*elemsize,y,err); 45*0acb07cdSJeremy L Thompson call ceedvectorsetvalue(y,0.d0,err) 46be9261b7Sjeremylt 47be9261b7Sjeremylt! No Transpose 48*0acb07cdSJeremy L Thompson call ceedelemrestrictionapplyblock(r,1,ceed_notranspose,x,y,& 49*0acb07cdSJeremy L Thompson & 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=blksize,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 & blksize*elemsize 59*0acb07cdSJeremy L Thompson diff=yy(yoffset+indx+1) 60*0acb07cdSJeremy L Thompson diff=diff-a(ind(k*elemsize+i+1)+1) 61*0acb07cdSJeremy L Thompson if (abs(diff) > 1.0D-15) then 62*0acb07cdSJeremy L Thompson! LCOV_EXCL_START 63*0acb07cdSJeremy L Thompson write(*,*) 'Error in restricted array y(',i,')(',j,')(',k,')=',& 64*0acb07cdSJeremy L Thompson & yy(yoffset+indx+1) 65*0acb07cdSJeremy L Thompson! LCOV_EXCL_STOP 66*0acb07cdSJeremy L Thompson endif 67*0acb07cdSJeremy L Thompson enddo 68*0acb07cdSJeremy L Thompson enddo 69*0acb07cdSJeremy L Thompson enddo 70*0acb07cdSJeremy L Thompson call ceedvectorrestorearrayread(y,yy,yoffset,err) 71be9261b7Sjeremylt 72be9261b7Sjeremylt! Transpose 73*0acb07cdSJeremy L Thompson call ceedvectorsetvalue(x,0.d0,err) 74*0acb07cdSJeremy L Thompson call ceedelemrestrictionapplyblock(r,1,ceed_transpose,y,x,& 75*0acb07cdSJeremy L Thompson & ceed_request_immediate,err) 76*0acb07cdSJeremy L Thompson call ceedvectorgetarrayread(x,ceed_mem_host,xx,xoffset,err) 77*0acb07cdSJeremy L Thompson do i=blksize+1,ne+1 78*0acb07cdSJeremy L Thompson diff=xx(xoffset+i) 79*0acb07cdSJeremy L Thompson if (i > blksize+1 .and. i < ne+1) then 80*0acb07cdSJeremy L Thompson diff=diff-2*(10+i-1) 81*0acb07cdSJeremy L Thompson else 82*0acb07cdSJeremy L Thompson diff=diff-(10+i-1) 83*0acb07cdSJeremy L Thompson endif 84*0acb07cdSJeremy L Thompson if (abs(diff) > 1.0D-15) then 85*0acb07cdSJeremy L Thompson! LCOV_EXCL_START 86*0acb07cdSJeremy L Thompson write(*,*) 'Error in restricted array x(',i,')=',& 87*0acb07cdSJeremy L Thompson & xx(xoffset+i) 88*0acb07cdSJeremy L Thompson! LCOV_EXCL_STOP 89*0acb07cdSJeremy L Thompson endif 90be9261b7Sjeremylt enddo 91*0acb07cdSJeremy L Thompson call ceedvectorrestorearrayread(x,xx,xoffset,err) 92be9261b7Sjeremylt 93be9261b7Sjeremylt call ceedvectordestroy(x,err) 94be9261b7Sjeremylt call ceedvectordestroy(y,err) 95be9261b7Sjeremylt call ceedelemrestrictiondestroy(r,err) 96be9261b7Sjeremylt call ceeddestroy(ceed,err) 97be9261b7Sjeremylt 98be9261b7Sjeremylt end 99be9261b7Sjeremylt!----------------------------------------------------------------------- 100