11134a487Sjeremylt!----------------------------------------------------------------------- 21134a487Sjeremylt program test 31f9a83abSJed Brown implicit none 4*ec3da8bcSJed Brown include 'ceed/fortran.h' 51134a487Sjeremylt 61134a487Sjeremylt integer ceed,err 71134a487Sjeremylt integer u,v 81134a487Sjeremylt integer qf 91134a487Sjeremylt integer q,s,i 101134a487Sjeremylt parameter(q=8) 111134a487Sjeremylt parameter(s=3) 121134a487Sjeremylt real*8 uu(q*s) 131134a487Sjeremylt real*8 vv(q*s) 141134a487Sjeremylt character arg*32 151134a487Sjeremylt integer*8 uoffset,voffset 161134a487Sjeremylt 171134a487Sjeremylt call getarg(1,arg) 181134a487Sjeremylt call ceedinit(trim(arg)//char(0),ceed,err) 191134a487Sjeremylt 2060f77c51Sjeremylt call ceedqfunctioncreateidentity(ceed,s,ceed_eval_interp,& 2160f77c51Sjeremylt & ceed_eval_interp,qf,err) 221134a487Sjeremylt 231134a487Sjeremylt do i=0,q*s-1 241134a487Sjeremylt uu(i+1)=i*i 251134a487Sjeremylt enddo 261134a487Sjeremylt 271134a487Sjeremylt call ceedvectorcreate(ceed,q*s,u,err) 281134a487Sjeremylt uoffset=0 291134a487Sjeremylt call ceedvectorsetarray(u,ceed_mem_host,ceed_use_pointer,uu,uoffset,err) 301134a487Sjeremylt call ceedvectorcreate(ceed,q*s,v,err) 311134a487Sjeremylt call ceedvectorsetvalue(v,0.d0,err) 321134a487Sjeremylt 331134a487Sjeremylt call ceedqfunctionapply(qf,q,u,ceed_null,ceed_null,ceed_null,& 341134a487Sjeremylt &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 351134a487Sjeremylt &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 361134a487Sjeremylt &v,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 371134a487Sjeremylt &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 381134a487Sjeremylt &ceed_null,ceed_null,ceed_null,ceed_null,err) 391134a487Sjeremylt 401134a487Sjeremylt call ceedvectorgetarrayread(v,ceed_mem_host,vv,voffset,err) 411134a487Sjeremylt do i=1,q*s 424e367ab1Sjeremylt if (abs(vv(i+voffset)-(i-1)*(i-1)) > 1.0D-12) then 431134a487Sjeremylt! LCOV_EXCL_START 441134a487Sjeremylt write(*,*) 'v(i)=',vv(i+voffset),', u(i)=',(i-1)*(i-1) 451134a487Sjeremylt! LCOV_EXCL_STOP 461134a487Sjeremylt endif 471134a487Sjeremylt enddo 481134a487Sjeremylt call ceedvectorrestorearrayread(v,vv,voffset,err) 491134a487Sjeremylt 501134a487Sjeremylt call ceedvectordestroy(u,err) 511134a487Sjeremylt call ceedvectordestroy(v,err) 521134a487Sjeremylt call ceedqfunctiondestroy(qf,err) 531134a487Sjeremylt call ceeddestroy(ceed,err) 541134a487Sjeremylt end 551134a487Sjeremylt!----------------------------------------------------------------------- 56