18980d4a7Sjeremylt!----------------------------------------------------------------------- 2752c3701SJeremy L Thompson! 3752c3701SJeremy L Thompson! Header with QFunctions 4752c3701SJeremy L Thompson! 5752c3701SJeremy L Thompson include 't401-qfunction-f.h' 68980d4a7Sjeremylt!----------------------------------------------------------------------- 78980d4a7Sjeremylt program test 81f9a83abSJed Brown implicit none 9*ec3da8bcSJed Brown include 'ceed/fortran.h' 108980d4a7Sjeremylt 118980d4a7Sjeremylt integer ceed,err 128980d4a7Sjeremylt integer qdata,w,u,v 138980d4a7Sjeremylt integer qf_setup,qf_mass 14777ff853SJeremy L Thompson integer ctx 158980d4a7Sjeremylt integer q,i 168980d4a7Sjeremylt parameter(q=8) 178980d4a7Sjeremylt real*8 ww(q) 188980d4a7Sjeremylt real*8 uu(q) 198980d4a7Sjeremylt real*8 vv(q) 208980d4a7Sjeremylt real*8 vvv(q) 218980d4a7Sjeremylt integer ctxsize 228980d4a7Sjeremylt parameter(ctxsize=5) 23777ff853SJeremy L Thompson real*8 ctxdata(5) 248980d4a7Sjeremylt real*8 x 258980d4a7Sjeremylt character arg*32 26777ff853SJeremy L Thompson integer*8 uoffset,voffset,woffset,coffset 278980d4a7Sjeremylt 288980d4a7Sjeremylt external setup,mass 298980d4a7Sjeremylt 30777ff853SJeremy L Thompson ctxdata=(/1.d0,2.d0,3.d0,4.d0,5.d0/) 318980d4a7Sjeremylt 328980d4a7Sjeremylt call getarg(1,arg) 338980d4a7Sjeremylt call ceedinit(trim(arg)//char(0),ceed,err) 348980d4a7Sjeremylt 358980d4a7Sjeremylt call ceedqfunctioncreateinterior(ceed,1,setup,& 362d50dd3dSjeremylt &SOURCE_DIR& 372d50dd3dSjeremylt &//'t401-qfunction.h:setup'//char(0),qf_setup,err) 3884e209c4Sjeremylt call ceedqfunctionaddinput(qf_setup,'w', 1,ceed_eval_weight,err) 3984e209c4Sjeremylt call ceedqfunctionaddoutput(qf_setup,'qdata',1,ceed_eval_none,err) 408980d4a7Sjeremylt 418980d4a7Sjeremylt call ceedqfunctioncreateinterior(ceed,1,mass,& 422d50dd3dSjeremylt &SOURCE_DIR& 432d50dd3dSjeremylt &//'t401-qfunction.h:mass'//char(0),qf_mass,err) 4484e209c4Sjeremylt call ceedqfunctionaddinput(qf_mass,'qdata',1,ceed_eval_none,err) 458980d4a7Sjeremylt call ceedqfunctionaddinput(qf_mass,'u',1,ceed_eval_interp,err) 468980d4a7Sjeremylt call ceedqfunctionaddoutput(qf_mass,'v',1,ceed_eval_interp,err) 478980d4a7Sjeremylt 48777ff853SJeremy L Thompson call ceedqfunctioncontextcreate(ceed,ctx,err) 49777ff853SJeremy L Thompson coffset=0 50777ff853SJeremy L Thompson call ceedqfunctioncontextsetdata(ctx,ceed_mem_host,ceed_use_pointer,ctxsize,& 51777ff853SJeremy L Thompson & ctxdata,coffset,err) 52777ff853SJeremy L Thompson call ceedqfunctionsetcontext(qf_mass,ctx,err) 538980d4a7Sjeremylt 548980d4a7Sjeremylt do i=0,q-1 558980d4a7Sjeremylt x=2.0*i/(q-1)-1 568980d4a7Sjeremylt ww(i+1)=1-x*x 578980d4a7Sjeremylt uu(i+1)=2+3*x+5*x*x 588980d4a7Sjeremylt vvv(i+1)=ww(i+1)*uu(i+1) 598980d4a7Sjeremylt enddo 608980d4a7Sjeremylt 618980d4a7Sjeremylt call ceedvectorcreate(ceed,q,w,err) 62c8b9fe72Sjeremylt woffset=0 63c8b9fe72Sjeremylt call ceedvectorsetarray(w,ceed_mem_host,ceed_use_pointer,ww,woffset,err) 648980d4a7Sjeremylt call ceedvectorcreate(ceed,q,u,err) 65c8b9fe72Sjeremylt uoffset=0 66c8b9fe72Sjeremylt call ceedvectorsetarray(u,ceed_mem_host,ceed_use_pointer,uu,uoffset,err) 678980d4a7Sjeremylt call ceedvectorcreate(ceed,q,v,err) 688980d4a7Sjeremylt call ceedvectorsetvalue(v,0.d0,err) 698980d4a7Sjeremylt call ceedvectorcreate(ceed,q,qdata,err) 708980d4a7Sjeremylt call ceedvectorsetvalue(qdata,0.d0,err) 718980d4a7Sjeremylt 728980d4a7Sjeremylt call ceedqfunctionapply(qf_setup,q,w,ceed_null,ceed_null,ceed_null,& 738980d4a7Sjeremylt &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 748980d4a7Sjeremylt &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 758980d4a7Sjeremylt &qdata,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 768980d4a7Sjeremylt &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 778980d4a7Sjeremylt &ceed_null,ceed_null,ceed_null,ceed_null,err) 788980d4a7Sjeremylt 798980d4a7Sjeremylt call ceedqfunctionapply(qf_mass,q,u,qdata,ceed_null,ceed_null,& 808980d4a7Sjeremylt &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 818980d4a7Sjeremylt &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 828980d4a7Sjeremylt &v,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 838980d4a7Sjeremylt &ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,ceed_null,& 848980d4a7Sjeremylt &ceed_null,ceed_null,ceed_null,ceed_null,err) 858980d4a7Sjeremylt 86c8b9fe72Sjeremylt call ceedvectorgetarrayread(v,ceed_mem_host,vv,voffset,err) 878980d4a7Sjeremylt do i=1,q 88777ff853SJeremy L Thompson if (abs(vv(i+voffset)-ctxdata(5)*vvv(i)) > 1.0D-14) then 89a2546046Sjeremylt! LCOV_EXCL_START 90777ff853SJeremy L Thompson write(*,*) 'v(i)=',vv(i+voffset),', 5*vv(i)=',ctxdata(5)*vvv(i) 91de996c55Sjeremylt! LCOV_EXCL_STOP 928980d4a7Sjeremylt endif 938980d4a7Sjeremylt enddo 94c8b9fe72Sjeremylt call ceedvectorrestorearrayread(v,vv,voffset,err) 958980d4a7Sjeremylt 968980d4a7Sjeremylt call ceedvectordestroy(u,err) 978980d4a7Sjeremylt call ceedvectordestroy(v,err) 988980d4a7Sjeremylt call ceedvectordestroy(w,err) 998980d4a7Sjeremylt call ceedvectordestroy(qdata,err) 1008980d4a7Sjeremylt call ceedqfunctiondestroy(qf_setup,err) 1018980d4a7Sjeremylt call ceedqfunctiondestroy(qf_mass,err) 102777ff853SJeremy L Thompson call ceedqfunctioncontextdestroy(ctx,err) 1038980d4a7Sjeremylt call ceeddestroy(ceed,err) 1048980d4a7Sjeremylt end 1058980d4a7Sjeremylt!----------------------------------------------------------------------- 106