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