1*9d488d03SJeremy L Thompson!----------------------------------------------------------------------- 2*9d488d03SJeremy L Thompson program test 3*9d488d03SJeremy L Thompson implicit none 4*9d488d03SJeremy L Thompson include 'ceedf.h' 5*9d488d03SJeremy L Thompson 6*9d488d03SJeremy L Thompson integer ceed,err 7*9d488d03SJeremy L Thompson integer i,x,n 8*9d488d03SJeremy L Thompson real*8 a(10) 9*9d488d03SJeremy L Thompson real*8 b(10) 10*9d488d03SJeremy L Thompson real*8 c(10) 11*9d488d03SJeremy L Thompson real*8 diff 12*9d488d03SJeremy L Thompson integer*8 aoffset,boffset,coffset 13*9d488d03SJeremy L Thompson character arg*32 14*9d488d03SJeremy L Thompson 15*9d488d03SJeremy L Thompson call getarg(1,arg) 16*9d488d03SJeremy L Thompson 17*9d488d03SJeremy L Thompson call ceedinit(trim(arg)//char(0),ceed,err) 18*9d488d03SJeremy L Thompson 19*9d488d03SJeremy L Thompson n=10 20*9d488d03SJeremy L Thompson 21*9d488d03SJeremy L Thompson call ceedvectorcreate(ceed,n,x,err) 22*9d488d03SJeremy L Thompson 23*9d488d03SJeremy L Thompson do i=1,10 24*9d488d03SJeremy L Thompson a(i)=0 25*9d488d03SJeremy L Thompson enddo 26*9d488d03SJeremy L Thompson a(3)=-3.14 27*9d488d03SJeremy L Thompson 28*9d488d03SJeremy L Thompson aoffset=0 29*9d488d03SJeremy L Thompson call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err) 30*9d488d03SJeremy L Thompson 31*9d488d03SJeremy L Thompson! Taking array should return a 32*9d488d03SJeremy L Thompson call ceedvectortakearray(x,ceed_mem_host,c,coffset,err) 33*9d488d03SJeremy L Thompson diff=c(coffset+3)+3.14 34*9d488d03SJeremy L Thompson if (abs(diff)>1.0D-15) then 35*9d488d03SJeremy L Thompson! LCOV_EXCL_START 36*9d488d03SJeremy L Thompson write(*,*) 'Error taking array c(3)=',c(3) 37*9d488d03SJeremy L Thompson! LCOV_EXCL_STOP 38*9d488d03SJeremy L Thompson endif 39*9d488d03SJeremy L Thompson 40*9d488d03SJeremy L Thompson! Getting array should not modify a 41*9d488d03SJeremy L Thompson call ceedvectorgetarray(x,ceed_mem_host,b,boffset,err) 42*9d488d03SJeremy L Thompson b(boffset+5) = -3.14 43*9d488d03SJeremy L Thompson call ceedvectorrestorearray(x,b,boffset,err) 44*9d488d03SJeremy L Thompson diff=a(5)+3.14 45*9d488d03SJeremy L Thompson if (abs(diff)<1.0D-15) then 46*9d488d03SJeremy L Thompson! LCOV_EXCL_START 47*9d488d03SJeremy L Thompson write(*,*) 'Error protecting array a(3)=',a(3) 48*9d488d03SJeremy L Thompson! LCOV_EXCL_STOP 49*9d488d03SJeremy L Thompson endif 50*9d488d03SJeremy L Thompson 51*9d488d03SJeremy L Thompson call ceedvectordestroy(x,err) 52*9d488d03SJeremy L Thompson call ceeddestroy(ceed,err) 53*9d488d03SJeremy L Thompson 54*9d488d03SJeremy L Thompson end 55*9d488d03SJeremy L Thompson!----------------------------------------------------------------------- 56