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