1*8980d4a7Sjeremylt!----------------------------------------------------------------------- 2*8980d4a7Sjeremylt program test 3*8980d4a7Sjeremylt 4*8980d4a7Sjeremylt include 'ceedf.h' 5*8980d4a7Sjeremylt 6*8980d4a7Sjeremylt integer ceed,err 7*8980d4a7Sjeremylt integer x,y 8*8980d4a7Sjeremylt integer r 9*8980d4a7Sjeremylt integer i 10*8980d4a7Sjeremylt integer*8 offset 11*8980d4a7Sjeremylt 12*8980d4a7Sjeremylt integer ne 13*8980d4a7Sjeremylt parameter(ne=3) 14*8980d4a7Sjeremylt 15*8980d4a7Sjeremylt integer*4 ind(2*ne) 16*8980d4a7Sjeremylt real*8 a(ne+1) 17*8980d4a7Sjeremylt real*8 yy(2*ne) 18*8980d4a7Sjeremylt real*8 diff 19*8980d4a7Sjeremylt 20*8980d4a7Sjeremylt character arg*32 21*8980d4a7Sjeremylt 22*8980d4a7Sjeremylt call getarg(1,arg) 23*8980d4a7Sjeremylt call ceedinit(trim(arg)//char(0),ceed,err) 24*8980d4a7Sjeremylt 25*8980d4a7Sjeremylt call ceedvectorcreate(ceed,ne+1,x,err) 26*8980d4a7Sjeremylt 27*8980d4a7Sjeremylt do i=1,ne+1 28*8980d4a7Sjeremylt a(i)=10+i-1 29*8980d4a7Sjeremylt enddo 30*8980d4a7Sjeremylt 31*8980d4a7Sjeremylt call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,err) 32*8980d4a7Sjeremylt 33*8980d4a7Sjeremylt do i=1,ne 34*8980d4a7Sjeremylt ind(2*i-1)=i-1 35*8980d4a7Sjeremylt ind(2*i )=i 36*8980d4a7Sjeremylt enddo 37*8980d4a7Sjeremylt 38*8980d4a7Sjeremylt call ceedelemrestrictioncreate(ceed,ne,2,ne+1,1,ceed_mem_host,& 39*8980d4a7Sjeremylt & ceed_use_pointer,ind,r,err) 40*8980d4a7Sjeremylt 41*8980d4a7Sjeremylt call ceedvectorcreate(ceed,2*ne,y,err); 42*8980d4a7Sjeremylt call ceedvectorsetvalue(y,0.d0,err); 43*8980d4a7Sjeremylt call ceedelemrestrictionapply(r,ceed_notranspose,ceed_notranspose,x,y,& 44*8980d4a7Sjeremylt & ceed_request_immediate,err) 45*8980d4a7Sjeremylt 46*8980d4a7Sjeremylt call ceedvectorgetarrayread(y,ceed_mem_host,yy,offset,err) 47*8980d4a7Sjeremylt do i=1,ne*2 48*8980d4a7Sjeremylt diff=10+i/2-yy(i+offset) 49*8980d4a7Sjeremylt if (abs(diff) > 1.0D-15) then 50*8980d4a7Sjeremylt write(*,*) 'Error in restricted array y(',i,')=',yy(i+offset) 51*8980d4a7Sjeremylt endif 52*8980d4a7Sjeremylt enddo 53*8980d4a7Sjeremylt call ceedvectorrestorearrayread(y,yy,offset,err) 54*8980d4a7Sjeremylt 55*8980d4a7Sjeremylt call ceedvectordestroy(x,err) 56*8980d4a7Sjeremylt call ceedvectordestroy(y,err) 57*8980d4a7Sjeremylt call ceedelemrestrictiondestroy(r,err) 58*8980d4a7Sjeremylt call ceeddestroy(ceed,err) 59*8980d4a7Sjeremylt 60*8980d4a7Sjeremylt end 61*8980d4a7Sjeremylt!----------------------------------------------------------------------- 62