1*0219ea01SJeremy L Thompson!----------------------------------------------------------------------- 2*0219ea01SJeremy L Thompson program test 3*0219ea01SJeremy L Thompson 4*0219ea01SJeremy L Thompson include 'ceedf.h' 5*0219ea01SJeremy L Thompson 6*0219ea01SJeremy L Thompson integer ceed,err 7*0219ea01SJeremy L Thompson integer u,v 8*0219ea01SJeremy L Thompson integer qf 9*0219ea01SJeremy L Thompson integer q,i 10*0219ea01SJeremy L Thompson parameter(q=8) 11*0219ea01SJeremy L Thompson real*8 uu(q) 12*0219ea01SJeremy L Thompson real*8 vv(q) 13*0219ea01SJeremy L Thompson character arg*32 14*0219ea01SJeremy L Thompson integer*8 uoffset,voffset 15*0219ea01SJeremy L Thompson 16*0219ea01SJeremy L Thompson call getarg(1,arg) 17*0219ea01SJeremy L Thompson call ceedinit(trim(arg)//char(0),ceed,err) 18*0219ea01SJeremy L Thompson 19*0219ea01SJeremy L Thompson call ceedqfunctioncreateidentity(ceed,1,qf,err) 20*0219ea01SJeremy L Thompson 21*0219ea01SJeremy L Thompson do i=0,q-1 22*0219ea01SJeremy L Thompson uu(i+1)=i*i 23*0219ea01SJeremy L Thompson enddo 24*0219ea01SJeremy L Thompson 25*0219ea01SJeremy L Thompson call ceedvectorcreate(ceed,q,u,err) 26*0219ea01SJeremy L Thompson uoffset=0 27*0219ea01SJeremy L Thompson call ceedvectorsetarray(u,ceed_mem_host,ceed_use_pointer,uu,uoffset,err) 28*0219ea01SJeremy L Thompson call ceedvectorcreate(ceed,q,v,err) 29*0219ea01SJeremy L Thompson call ceedvectorsetvalue(v,0.d0,err) 30*0219ea01SJeremy L Thompson 31*0219ea01SJeremy L Thompson call ceedqfunctionapply(qf,q,u,ceed_null,ceed_null,ceed_null,& 32*0219ea01SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 33*0219ea01SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 34*0219ea01SJeremy L Thompson &v,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 35*0219ea01SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 36*0219ea01SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,err) 37*0219ea01SJeremy L Thompson 38*0219ea01SJeremy L Thompson call ceedvectorgetarrayread(v,ceed_mem_host,vv,voffset,err) 39*0219ea01SJeremy L Thompson do i=1,q 40*0219ea01SJeremy L Thompson if (abs(vv(i+voffset)-(i-1)*(i-1)) > 1.0D-14) then 41*0219ea01SJeremy L Thompson! LCOV_EXCL_START 42*0219ea01SJeremy L Thompson write(*,*) 'v(i)=',vv(i+voffset),', u(i)=',(i-1)*(i-1) 43*0219ea01SJeremy L Thompson! LCOV_EXCL_STOP 44*0219ea01SJeremy L Thompson endif 45*0219ea01SJeremy L Thompson enddo 46*0219ea01SJeremy L Thompson call ceedvectorrestorearrayread(v,vv,voffset,err) 47*0219ea01SJeremy L Thompson 48*0219ea01SJeremy L Thompson call ceedvectordestroy(u,err) 49*0219ea01SJeremy L Thompson call ceedvectordestroy(v,err) 50*0219ea01SJeremy L Thompson call ceedqfunctiondestroy(qf,err) 51*0219ea01SJeremy L Thompson call ceeddestroy(ceed,err) 52*0219ea01SJeremy L Thompson end 53*0219ea01SJeremy L Thompson!----------------------------------------------------------------------- 54