1be9261b7Sjeremylt!----------------------------------------------------------------------- 2be9261b7Sjeremylt program test 3be9261b7Sjeremylt 4be9261b7Sjeremylt include 'ceedf.h' 5be9261b7Sjeremylt 6be9261b7Sjeremylt integer ceed,err 7be9261b7Sjeremylt integer x,y 8be9261b7Sjeremylt integer r 9be9261b7Sjeremylt 10be9261b7Sjeremylt integer ne 11be9261b7Sjeremylt parameter(ne=8) 12be9261b7Sjeremylt integer blksize 13be9261b7Sjeremylt parameter(blksize=5) 14be9261b7Sjeremylt 15be9261b7Sjeremylt integer*4 ind(2*ne) 16be9261b7Sjeremylt real*8 a(ne+1) 17be9261b7Sjeremylt integer*8 aoffset 18be9261b7Sjeremylt 19be9261b7Sjeremylt character arg*32 20be9261b7Sjeremylt 21be9261b7Sjeremylt call getarg(1,arg) 22be9261b7Sjeremylt call ceedinit(trim(arg)//char(0),ceed,err) 23be9261b7Sjeremylt 24be9261b7Sjeremylt call ceedvectorcreate(ceed,ne+1,x,err) 25be9261b7Sjeremylt 26be9261b7Sjeremylt do i=1,ne+1 27be9261b7Sjeremylt a(i)=10+i-1 28be9261b7Sjeremylt enddo 29be9261b7Sjeremylt 30*9fbf56acSjeremylt aoffset=0 31*9fbf56acSjeremylt call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err) 32be9261b7Sjeremylt 33be9261b7Sjeremylt do i=1,ne 34be9261b7Sjeremylt ind(2*i-1)=i-1 35be9261b7Sjeremylt ind(2*i )=i 36be9261b7Sjeremylt enddo 37be9261b7Sjeremylt 38be9261b7Sjeremylt call ceedelemrestrictioncreateblocked(ceed,ne,2,blksize,ne+1,1,& 39be9261b7Sjeremylt & ceed_mem_host,ceed_use_pointer,ind,r,err) 40be9261b7Sjeremylt 41be9261b7Sjeremylt call ceedvectorcreate(ceed,blksize*2,y,err); 42be9261b7Sjeremylt call ceedvectorsetvalue(y,0.d0,err); 43be9261b7Sjeremylt 44be9261b7Sjeremylt! No Transpose 45be9261b7Sjeremylt call ceedelemrestrictionapplyblock(r,1,ceed_notranspose,ceed_notranspose,& 46be9261b7Sjeremylt & x,y,ceed_request_immediate,err) 47be9261b7Sjeremylt call ceedvectorview(y,err) 48be9261b7Sjeremylt 49be9261b7Sjeremylt! Transpose 50be9261b7Sjeremylt call ceedvectorgetarray(x,ceed_mem_host,a,aoffset,err) 51be9261b7Sjeremylt do i=1,ne+1 52be9261b7Sjeremylt a(aoffset+i)=0.0 53be9261b7Sjeremylt enddo 54be9261b7Sjeremylt call ceedvectorrestorearray(x,a,aoffset,err) 55be9261b7Sjeremylt 56be9261b7Sjeremylt call ceedelemrestrictionapplyblock(r,1,ceed_transpose,ceed_notranspose,& 57be9261b7Sjeremylt & y,x,ceed_request_immediate,err) 58be9261b7Sjeremylt 59be9261b7Sjeremylt call ceedvectorview(x,err) 60be9261b7Sjeremylt 61be9261b7Sjeremylt call ceedvectordestroy(x,err) 62be9261b7Sjeremylt call ceedvectordestroy(y,err) 63be9261b7Sjeremylt call ceedelemrestrictiondestroy(r,err) 64be9261b7Sjeremylt call ceeddestroy(ceed,err) 65be9261b7Sjeremylt 66be9261b7Sjeremylt end 67be9261b7Sjeremylt!----------------------------------------------------------------------- 68