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