152bfb9bbSJeremy L Thompson!----------------------------------------------------------------------- 252bfb9bbSJeremy L Thompson! 352bfb9bbSJeremy L Thompson! Header with common subroutine 452bfb9bbSJeremy L Thompson! 552bfb9bbSJeremy L Thompson include 't320-basis-f.h' 652bfb9bbSJeremy L Thompson!----------------------------------------------------------------------- 752bfb9bbSJeremy L Thompson subroutine feval(x1,x2,val) 852bfb9bbSJeremy L Thompson real*8 x1,x2,val 952bfb9bbSJeremy L Thompson 1052bfb9bbSJeremy L Thompson val=x1*x1+x2*x2+x1*x2+1 1152bfb9bbSJeremy L Thompson 1252bfb9bbSJeremy L Thompson end 1352bfb9bbSJeremy L Thompson!----------------------------------------------------------------------- 1452bfb9bbSJeremy L Thompson subroutine dfeval(x1,x2,val) 1552bfb9bbSJeremy L Thompson real*8 x1,x2,val 1652bfb9bbSJeremy L Thompson 1752bfb9bbSJeremy L Thompson val=2*x1+x2 1852bfb9bbSJeremy L Thompson 1952bfb9bbSJeremy L Thompson end 2052bfb9bbSJeremy L Thompson!----------------------------------------------------------------------- 2152bfb9bbSJeremy L Thompson program test 221f9a83abSJed Brown implicit none 23*ec3da8bcSJed Brown include 'ceed/fortran.h' 2452bfb9bbSJeremy L Thompson 2552bfb9bbSJeremy L Thompson integer ceed,err 2652bfb9bbSJeremy L Thompson integer input,output 2752bfb9bbSJeremy L Thompson integer p,q,d 2852bfb9bbSJeremy L Thompson parameter(p=6) 2952bfb9bbSJeremy L Thompson parameter(q=4) 3052bfb9bbSJeremy L Thompson parameter(d=2) 3152bfb9bbSJeremy L Thompson 3252bfb9bbSJeremy L Thompson real*8 qref(d*q) 3352bfb9bbSJeremy L Thompson real*8 qweight(q) 3452bfb9bbSJeremy L Thompson real*8 interp(p*q) 3552bfb9bbSJeremy L Thompson real*8 grad(d*p*q) 3652bfb9bbSJeremy L Thompson real*8 xq(d*q) 3752bfb9bbSJeremy L Thompson real*8 xr(d*p) 3852bfb9bbSJeremy L Thompson real*8 iinput(p) 3952bfb9bbSJeremy L Thompson real*8 ooutput(d*q) 4052bfb9bbSJeremy L Thompson real*8 val,diff 4152bfb9bbSJeremy L Thompson real*8 x1,x2 4252bfb9bbSJeremy L Thompson integer*8 ioffset,ooffset 4352bfb9bbSJeremy L Thompson 441f9a83abSJed Brown integer b,i 4552bfb9bbSJeremy L Thompson 4652bfb9bbSJeremy L Thompson character arg*32 4752bfb9bbSJeremy L Thompson 4852bfb9bbSJeremy L Thompson xq=(/2.d-1,6.d-1,1.d0/3.d0,2.d-1,2.d-1,2.d-1, 1.d0/3.d0,6.d-1/) 4952bfb9bbSJeremy L Thompson xr=(/0.d0,5.d-1,1.d0,0.d0,5.d-1,0.d0,0.d0,0.d0, 0.d0,5.d-1,5.d-1,1.d0/) 5052bfb9bbSJeremy L Thompson 5152bfb9bbSJeremy L Thompson call getarg(1,arg) 5252bfb9bbSJeremy L Thompson 5352bfb9bbSJeremy L Thompson call buildmats(qref,qweight,interp,grad) 5452bfb9bbSJeremy L Thompson 5552bfb9bbSJeremy L Thompson call ceedinit(trim(arg)//char(0),ceed,err) 5652bfb9bbSJeremy L Thompson 5752bfb9bbSJeremy L Thompson call ceedbasiscreateh1(ceed,ceed_triangle,1,p,q,interp,grad,qref,qweight,& 5852bfb9bbSJeremy L Thompson & b,err) 5952bfb9bbSJeremy L Thompson 6052bfb9bbSJeremy L Thompson do i=1,p 6152bfb9bbSJeremy L Thompson x1=xr(0*p+i) 6252bfb9bbSJeremy L Thompson x2=xr(1*p+i) 6352bfb9bbSJeremy L Thompson call feval(x1,x2,val) 6452bfb9bbSJeremy L Thompson iinput(i)=val 6552bfb9bbSJeremy L Thompson enddo 6652bfb9bbSJeremy L Thompson 6752bfb9bbSJeremy L Thompson call ceedvectorcreate(ceed,p,input,err) 6852bfb9bbSJeremy L Thompson ioffset=0 6952bfb9bbSJeremy L Thompson call ceedvectorsetarray(input,ceed_mem_host,ceed_use_pointer,iinput,& 7052bfb9bbSJeremy L Thompson & ioffset,err) 7152bfb9bbSJeremy L Thompson call ceedvectorcreate(ceed,q*d,output,err) 7252bfb9bbSJeremy L Thompson call ceedvectorsetvalue(output,0.d0,err) 7352bfb9bbSJeremy L Thompson 7452bfb9bbSJeremy L Thompson call ceedbasisapply(b,1,ceed_notranspose,ceed_eval_grad,input,output,err) 7552bfb9bbSJeremy L Thompson 7652bfb9bbSJeremy L Thompson call ceedvectorgetarrayread(output,ceed_mem_host,ooutput,ooffset,err) 7752bfb9bbSJeremy L Thompson do i=1,q 7852bfb9bbSJeremy L Thompson x1=xq(0*q+i) 7952bfb9bbSJeremy L Thompson x2=xq(1*q+i) 8052bfb9bbSJeremy L Thompson call dfeval(x1,x2,val) 8152bfb9bbSJeremy L Thompson diff=val-ooutput(0*q+i+ooffset) 8252bfb9bbSJeremy L Thompson if (abs(diff)>1.0d-10) then 8352bfb9bbSJeremy L Thompson! LCOV_EXCL_START 8452bfb9bbSJeremy L Thompson write(*,'(A,I1,A,F12.8,A,F12.8)') '[',i,'] ',ooutput(i+ooffset),& 8552bfb9bbSJeremy L Thompson & ' != ',val 8652bfb9bbSJeremy L Thompson! LCOV_EXCL_STOP 8752bfb9bbSJeremy L Thompson endif 8852bfb9bbSJeremy L Thompson call dfeval(x2,x1,val) 8952bfb9bbSJeremy L Thompson diff=val-ooutput(1*q+i+ooffset) 9052bfb9bbSJeremy L Thompson if (abs(diff)>1.0d-10) then 9152bfb9bbSJeremy L Thompson! LCOV_EXCL_START 9252bfb9bbSJeremy L Thompson write(*,'(A,I1,A,F12.8,A,F12.8)') '[',i,'] ',ooutput(i+ooffset),& 9352bfb9bbSJeremy L Thompson & ' != ',val 9452bfb9bbSJeremy L Thompson! LCOV_EXCL_STOP 9552bfb9bbSJeremy L Thompson endif 9652bfb9bbSJeremy L Thompson enddo 9752bfb9bbSJeremy L Thompson call ceedvectorrestorearrayread(output,ooutput,ooffset,err) 9852bfb9bbSJeremy L Thompson 9952bfb9bbSJeremy L Thompson call ceedvectordestroy(input,err) 10052bfb9bbSJeremy L Thompson call ceedvectordestroy(output,err) 10152bfb9bbSJeremy L Thompson call ceedbasisdestroy(b,err) 10252bfb9bbSJeremy L Thompson call ceeddestroy(ceed,err) 10352bfb9bbSJeremy L Thompson 10452bfb9bbSJeremy L Thompson end 10552bfb9bbSJeremy L Thompson!----------------------------------------------------------------------- 106