19d488d03SJeremy L Thompson!----------------------------------------------------------------------- 29d488d03SJeremy L Thompson program test 39d488d03SJeremy L Thompson implicit none 4ec3da8bcSJed Brown include 'ceed/fortran.h' 59d488d03SJeremy L Thompson 69d488d03SJeremy L Thompson integer ceed,err 79d488d03SJeremy L Thompson integer i,x,n 89d488d03SJeremy L Thompson real*8 a(10) 99d488d03SJeremy L Thompson real*8 b(10) 109d488d03SJeremy L Thompson real*8 c(10) 119d488d03SJeremy L Thompson real*8 diff 129d488d03SJeremy L Thompson integer*8 aoffset,boffset,coffset 139d488d03SJeremy L Thompson character arg*32 149d488d03SJeremy L Thompson 159d488d03SJeremy L Thompson call getarg(1,arg) 169d488d03SJeremy L Thompson 179d488d03SJeremy L Thompson call ceedinit(trim(arg)//char(0),ceed,err) 189d488d03SJeremy L Thompson 199d488d03SJeremy L Thompson n=10 209d488d03SJeremy L Thompson 219d488d03SJeremy L Thompson call ceedvectorcreate(ceed,n,x,err) 229d488d03SJeremy L Thompson 239d488d03SJeremy L Thompson do i=1,10 249d488d03SJeremy L Thompson a(i)=0 259d488d03SJeremy L Thompson enddo 269d488d03SJeremy L Thompson a(3)=-3.14 279d488d03SJeremy L Thompson 289d488d03SJeremy L Thompson aoffset=0 299d488d03SJeremy L Thompson call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,a,aoffset,err) 309d488d03SJeremy L Thompson 319d488d03SJeremy L Thompson! Taking array should return a 329d488d03SJeremy L Thompson call ceedvectortakearray(x,ceed_mem_host,c,coffset,err) 339d488d03SJeremy L Thompson diff=c(coffset+3)+3.14 349d488d03SJeremy L Thompson if (abs(diff)>1.0D-15) then 359d488d03SJeremy L Thompson! LCOV_EXCL_START 369d488d03SJeremy L Thompson write(*,*) 'Error taking array c(3)=',c(3) 379d488d03SJeremy L Thompson! LCOV_EXCL_STOP 389d488d03SJeremy L Thompson endif 399d488d03SJeremy L Thompson 409d488d03SJeremy L Thompson! Getting array should not modify a 41*9c774eddSJeremy L Thompson call ceedvectorgetarraywrite(x,ceed_mem_host,b,boffset,err) 429d488d03SJeremy L Thompson b(boffset+5) = -3.14 439d488d03SJeremy L Thompson call ceedvectorrestorearray(x,b,boffset,err) 449d488d03SJeremy L Thompson diff=a(5)+3.14 459d488d03SJeremy L Thompson if (abs(diff)<1.0D-15) then 469d488d03SJeremy L Thompson! LCOV_EXCL_START 479d488d03SJeremy L Thompson write(*,*) 'Error protecting array a(3)=',a(3) 489d488d03SJeremy L Thompson! LCOV_EXCL_STOP 499d488d03SJeremy L Thompson endif 509d488d03SJeremy L Thompson 519d488d03SJeremy L Thompson call ceedvectordestroy(x,err) 529d488d03SJeremy L Thompson call ceeddestroy(ceed,err) 539d488d03SJeremy L Thompson 549d488d03SJeremy L Thompson end 559d488d03SJeremy L Thompson!----------------------------------------------------------------------- 56