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,qf,err) 21 22 do i=0,q*s-1 23 uu(i+1)=i*i 24 enddo 25 26 call ceedvectorcreate(ceed,q*s,u,err) 27 uoffset=0 28 call ceedvectorsetarray(u,ceed_mem_host,ceed_use_pointer,uu,uoffset,err) 29 call ceedvectorcreate(ceed,q*s,v,err) 30 call ceedvectorsetvalue(v,0.d0,err) 31 32 call ceedqfunctionapply(qf,q,u,ceed_null,ceed_null,ceed_null,& 33 &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 34 &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 35 &v,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 36 &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 37 &ceed_null,ceed_null,ceed_null,ceed_null,err) 38 39 call ceedvectorgetarrayread(v,ceed_mem_host,vv,voffset,err) 40 do i=1,q*s 41 if (abs(vv(i+voffset)-(i-1)*(i-1)) > 1.0D-14) then 42! LCOV_EXCL_START 43 write(*,*) 'v(i)=',vv(i+voffset),', u(i)=',(i-1)*(i-1) 44! LCOV_EXCL_STOP 45 endif 46 enddo 47 call ceedvectorrestorearrayread(v,vv,voffset,err) 48 49 call ceedvectordestroy(u,err) 50 call ceedvectordestroy(v,err) 51 call ceedqfunctiondestroy(qf,err) 52 call ceeddestroy(ceed,err) 53 end 54!----------------------------------------------------------------------- 55