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