10219ea01SJeremy L Thompson!----------------------------------------------------------------------- 20219ea01SJeremy L Thompson program test 31f9a83abSJed Brown implicit none 4*ec3da8bcSJed Brown include 'ceed/fortran.h' 50219ea01SJeremy L Thompson 60219ea01SJeremy L Thompson integer ceed,err 70219ea01SJeremy L Thompson integer u,v 80219ea01SJeremy L Thompson integer qf 90219ea01SJeremy L Thompson integer q,i 100219ea01SJeremy L Thompson parameter(q=8) 110219ea01SJeremy L Thompson real*8 uu(q) 120219ea01SJeremy L Thompson real*8 vv(q) 130219ea01SJeremy L Thompson character arg*32 140219ea01SJeremy L Thompson integer*8 uoffset,voffset 150219ea01SJeremy L Thompson 160219ea01SJeremy L Thompson call getarg(1,arg) 170219ea01SJeremy L Thompson call ceedinit(trim(arg)//char(0),ceed,err) 180219ea01SJeremy L Thompson 1960f77c51Sjeremylt call ceedqfunctioncreateidentity(ceed,1,ceed_eval_interp,& 2060f77c51Sjeremylt & ceed_eval_interp,qf,err) 210219ea01SJeremy L Thompson 220219ea01SJeremy L Thompson do i=0,q-1 230219ea01SJeremy L Thompson uu(i+1)=i*i 240219ea01SJeremy L Thompson enddo 250219ea01SJeremy L Thompson 260219ea01SJeremy L Thompson call ceedvectorcreate(ceed,q,u,err) 270219ea01SJeremy L Thompson uoffset=0 280219ea01SJeremy L Thompson call ceedvectorsetarray(u,ceed_mem_host,ceed_use_pointer,uu,uoffset,err) 290219ea01SJeremy L Thompson call ceedvectorcreate(ceed,q,v,err) 300219ea01SJeremy L Thompson call ceedvectorsetvalue(v,0.d0,err) 310219ea01SJeremy L Thompson 320219ea01SJeremy L Thompson call ceedqfunctionapply(qf,q,u,ceed_null,ceed_null,ceed_null,& 330219ea01SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 340219ea01SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 350219ea01SJeremy L Thompson &v,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 360219ea01SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 370219ea01SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,err) 380219ea01SJeremy L Thompson 390219ea01SJeremy L Thompson call ceedvectorgetarrayread(v,ceed_mem_host,vv,voffset,err) 400219ea01SJeremy L Thompson do i=1,q 410219ea01SJeremy L Thompson if (abs(vv(i+voffset)-(i-1)*(i-1)) > 1.0D-14) then 420219ea01SJeremy L Thompson! LCOV_EXCL_START 430219ea01SJeremy L Thompson write(*,*) 'v(i)=',vv(i+voffset),', u(i)=',(i-1)*(i-1) 440219ea01SJeremy L Thompson! LCOV_EXCL_STOP 450219ea01SJeremy L Thompson endif 460219ea01SJeremy L Thompson enddo 470219ea01SJeremy L Thompson call ceedvectorrestorearrayread(v,vv,voffset,err) 480219ea01SJeremy L Thompson 490219ea01SJeremy L Thompson call ceedvectordestroy(u,err) 500219ea01SJeremy L Thompson call ceedvectordestroy(v,err) 510219ea01SJeremy L Thompson call ceedqfunctiondestroy(qf,err) 520219ea01SJeremy L Thompson call ceeddestroy(ceed,err) 530219ea01SJeremy L Thompson end 540219ea01SJeremy L Thompson!----------------------------------------------------------------------- 55