1*288c0443SJeremy L Thompson!----------------------------------------------------------------------- 2*288c0443SJeremy L Thompson program test 3*288c0443SJeremy L Thompson 4*288c0443SJeremy L Thompson include 'ceedf.h' 5*288c0443SJeremy L Thompson 6*288c0443SJeremy L Thompson integer ceed,err 7*288c0443SJeremy L Thompson integer qdata,j,w,u,v 8*288c0443SJeremy L Thompson integer qf_setup,qf_mass 9*288c0443SJeremy L Thompson integer q,i 10*288c0443SJeremy L Thompson parameter(q=8) 11*288c0443SJeremy L Thompson real*8 jj(q) 12*288c0443SJeremy L Thompson real*8 ww(q) 13*288c0443SJeremy L Thompson real*8 uu(q) 14*288c0443SJeremy L Thompson real*8 vv(q) 15*288c0443SJeremy L Thompson real*8 vvv(q) 16*288c0443SJeremy L Thompson real*8 x 17*288c0443SJeremy L Thompson character arg*32 18*288c0443SJeremy L Thompson integer*8 joffset,uoffset,voffset,woffset 19*288c0443SJeremy L Thompson 20*288c0443SJeremy L Thompson call getarg(1,arg) 21*288c0443SJeremy L Thompson call ceedinit(trim(arg)//char(0),ceed,err) 22*288c0443SJeremy L Thompson 23*288c0443SJeremy L Thompson call ceedqfunctioncreateinteriorbyname(ceed,'Mass1DBuild',qf_setup,err) 24*288c0443SJeremy L Thompson call ceedqfunctioncreateinteriorbyname(ceed,'MassApply',qf_mass,err) 25*288c0443SJeremy L Thompson 26*288c0443SJeremy L Thompson do i=0,q-1 27*288c0443SJeremy L Thompson jj(i+1)=1 28*288c0443SJeremy L Thompson x=2.0*i/(q-1)-1 29*288c0443SJeremy L Thompson ww(i+1)=1-x*x 30*288c0443SJeremy L Thompson uu(i+1)=2+3*x+5*x*x 31*288c0443SJeremy L Thompson vvv(i+1)=ww(i+1)*uu(i+1) 32*288c0443SJeremy L Thompson enddo 33*288c0443SJeremy L Thompson 34*288c0443SJeremy L Thompson call ceedvectorcreate(ceed,q,j,err) 35*288c0443SJeremy L Thompson joffset=0 36*288c0443SJeremy L Thompson call ceedvectorsetarray(j,ceed_mem_host,ceed_use_pointer,jj,joffset,err) 37*288c0443SJeremy L Thompson call ceedvectorcreate(ceed,q,w,err) 38*288c0443SJeremy L Thompson woffset=0 39*288c0443SJeremy L Thompson call ceedvectorsetarray(w,ceed_mem_host,ceed_use_pointer,ww,woffset,err) 40*288c0443SJeremy L Thompson call ceedvectorcreate(ceed,q,u,err) 41*288c0443SJeremy L Thompson uoffset=0 42*288c0443SJeremy L Thompson call ceedvectorsetarray(u,ceed_mem_host,ceed_use_pointer,uu,uoffset,err) 43*288c0443SJeremy L Thompson call ceedvectorcreate(ceed,q,v,err) 44*288c0443SJeremy L Thompson call ceedvectorsetvalue(v,0.d0,err) 45*288c0443SJeremy L Thompson call ceedvectorcreate(ceed,q,qdata,err) 46*288c0443SJeremy L Thompson call ceedvectorsetvalue(qdata,0.d0,err) 47*288c0443SJeremy L Thompson 48*288c0443SJeremy L Thompson call ceedqfunctionapply(qf_setup,q,j,w,ceed_null,ceed_null,& 49*288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 50*288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 51*288c0443SJeremy L Thompson &qdata,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 52*288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 53*288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,err) 54*288c0443SJeremy L Thompson 55*288c0443SJeremy L Thompson call ceedqfunctionapply(qf_mass,q,u,qdata,ceed_null,ceed_null,& 56*288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 57*288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 58*288c0443SJeremy L Thompson &v,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 59*288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 60*288c0443SJeremy L Thompson &ceed_null,ceed_null,ceed_null,ceed_null,err) 61*288c0443SJeremy L Thompson 62*288c0443SJeremy L Thompson call ceedvectorgetarrayread(v,ceed_mem_host,vv,voffset,err) 63*288c0443SJeremy L Thompson do i=1,q 64*288c0443SJeremy L Thompson if (abs(vv(i+voffset)-vvv(i)) > 1.0D-14) then 65*288c0443SJeremy L Thompson! LCOV_EXCL_START 66*288c0443SJeremy L Thompson write(*,*) 'v(i)=',vv(i+voffset),', vv(i)=',vvv(i) 67*288c0443SJeremy L Thompson! LCOV_EXCL_STOP 68*288c0443SJeremy L Thompson endif 69*288c0443SJeremy L Thompson enddo 70*288c0443SJeremy L Thompson call ceedvectorrestorearrayread(v,vv,voffset,err) 71*288c0443SJeremy L Thompson 72*288c0443SJeremy L Thompson call ceedvectordestroy(u,err) 73*288c0443SJeremy L Thompson call ceedvectordestroy(v,err) 74*288c0443SJeremy L Thompson call ceedvectordestroy(w,err) 75*288c0443SJeremy L Thompson call ceedvectordestroy(qdata,err) 76*288c0443SJeremy L Thompson call ceedqfunctiondestroy(qf_setup,err) 77*288c0443SJeremy L Thompson call ceedqfunctiondestroy(qf_mass,err) 78*288c0443SJeremy L Thompson call ceeddestroy(ceed,err) 79*288c0443SJeremy L Thompson end 80*288c0443SJeremy L Thompson!----------------------------------------------------------------------- 81