1288c0443SJeremy L Thompson!----------------------------------------------------------------------- 2288c0443SJeremy L Thompson program test 31f9a83abSJed Brown implicit none 4*ec3da8bcSJed Brown include 'ceed/fortran.h' 5288c0443SJeremy L Thompson 6288c0443SJeremy L Thompson integer ceed,err 7288c0443SJeremy L Thompson integer qdata,j,w,u,v 8288c0443SJeremy L Thompson integer qf_setup,qf_mass 9288c0443SJeremy L Thompson integer q,i 10288c0443SJeremy L Thompson parameter(q=8) 11288c0443SJeremy L Thompson real*8 jj(q) 12288c0443SJeremy L Thompson real*8 ww(q) 13288c0443SJeremy L Thompson real*8 uu(q) 14288c0443SJeremy L Thompson real*8 vv(q) 15288c0443SJeremy L Thompson real*8 vvv(q) 16288c0443SJeremy L Thompson real*8 x 17288c0443SJeremy L Thompson character arg*32 18288c0443SJeremy L Thompson integer*8 joffset,uoffset,voffset,woffset 19288c0443SJeremy L Thompson 20288c0443SJeremy L Thompson call getarg(1,arg) 21288c0443SJeremy L Thompson call ceedinit(trim(arg)//char(0),ceed,err) 22288c0443SJeremy L Thompson 23288c0443SJeremy L Thompson call ceedqfunctioncreateinteriorbyname(ceed,'Mass1DBuild',qf_setup,err) 24288c0443SJeremy L Thompson call ceedqfunctioncreateinteriorbyname(ceed,'MassApply',qf_mass,err) 25288c0443SJeremy L Thompson 26288c0443SJeremy L Thompson do i=0,q-1 27288c0443SJeremy L Thompson jj(i+1)=1 28288c0443SJeremy L Thompson x=2.0*i/(q-1)-1 29288c0443SJeremy L Thompson ww(i+1)=1-x*x 30288c0443SJeremy L Thompson uu(i+1)=2+3*x+5*x*x 31288c0443SJeremy L Thompson vvv(i+1)=ww(i+1)*uu(i+1) 32288c0443SJeremy L Thompson enddo 33288c0443SJeremy L Thompson 34288c0443SJeremy L Thompson call ceedvectorcreate(ceed,q,j,err) 35288c0443SJeremy L Thompson joffset=0 36288c0443SJeremy L Thompson call ceedvectorsetarray(j,ceed_mem_host,ceed_use_pointer,jj,joffset,err) 37288c0443SJeremy L Thompson call ceedvectorcreate(ceed,q,w,err) 38288c0443SJeremy L Thompson woffset=0 39288c0443SJeremy L Thompson call ceedvectorsetarray(w,ceed_mem_host,ceed_use_pointer,ww,woffset,err) 40288c0443SJeremy L Thompson call ceedvectorcreate(ceed,q,u,err) 41288c0443SJeremy L Thompson uoffset=0 42288c0443SJeremy L Thompson call ceedvectorsetarray(u,ceed_mem_host,ceed_use_pointer,uu,uoffset,err) 43288c0443SJeremy L Thompson call ceedvectorcreate(ceed,q,v,err) 44288c0443SJeremy L Thompson call ceedvectorsetvalue(v,0.d0,err) 45288c0443SJeremy L Thompson call ceedvectorcreate(ceed,q,qdata,err) 46288c0443SJeremy L Thompson call ceedvectorsetvalue(qdata,0.d0,err) 47288c0443SJeremy L Thompson 48288c0443SJeremy L Thompson call ceedqfunctionapply(qf_setup,q,j,w,ceed_null,ceed_null,& 49288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 50288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 51288c0443SJeremy L Thompson &qdata,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 52288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 53288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,err) 54288c0443SJeremy L Thompson 55288c0443SJeremy L Thompson call ceedqfunctionapply(qf_mass,q,u,qdata,ceed_null,ceed_null,& 56288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 57288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 58288c0443SJeremy L Thompson &v,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 59288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 60288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,err) 61288c0443SJeremy L Thompson 62288c0443SJeremy L Thompson call ceedvectorgetarrayread(v,ceed_mem_host,vv,voffset,err) 63288c0443SJeremy L Thompson do i=1,q 64288c0443SJeremy L Thompson if (abs(vv(i+voffset)-vvv(i)) > 1.0D-14) then 65288c0443SJeremy L Thompson! LCOV_EXCL_START 66288c0443SJeremy L Thompson write(*,*) 'v(i)=',vv(i+voffset),', vv(i)=',vvv(i) 67288c0443SJeremy L Thompson! LCOV_EXCL_STOP 68288c0443SJeremy L Thompson endif 69288c0443SJeremy L Thompson enddo 70288c0443SJeremy L Thompson call ceedvectorrestorearrayread(v,vv,voffset,err) 71288c0443SJeremy L Thompson 72288c0443SJeremy L Thompson call ceedvectordestroy(u,err) 73288c0443SJeremy L Thompson call ceedvectordestroy(v,err) 74288c0443SJeremy L Thompson call ceedvectordestroy(w,err) 75288c0443SJeremy L Thompson call ceedvectordestroy(qdata,err) 76288c0443SJeremy L Thompson call ceedqfunctiondestroy(qf_setup,err) 77288c0443SJeremy L Thompson call ceedqfunctiondestroy(qf_mass,err) 78288c0443SJeremy L Thompson call ceeddestroy(ceed,err) 79288c0443SJeremy L Thompson end 80288c0443SJeremy L Thompson!----------------------------------------------------------------------- 81