11d102b48SJeremy L Thompson!----------------------------------------------------------------------- 21d102b48SJeremy L Thompson subroutine setup_mass(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,& 31d102b48SJeremy L Thompson& u14,u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,& 41d102b48SJeremy L Thompson& v16,ierr) 51d102b48SJeremy L Thompson real*8 ctx 61d102b48SJeremy L Thompson real*8 u1(1) 71d102b48SJeremy L Thompson real*8 u2(1) 81d102b48SJeremy L Thompson real*8 v1(1) 91d102b48SJeremy L Thompson integer q,ierr 101d102b48SJeremy L Thompson 111d102b48SJeremy L Thompson do i=1,q 121d102b48SJeremy L Thompson v1(i)=u2(i)*(u1(i+q*0)*u1(i+q*3)-u1(i+q*1)*u1(i+q*2)) 131d102b48SJeremy L Thompson enddo 141d102b48SJeremy L Thompson 151d102b48SJeremy L Thompson ierr=0 161d102b48SJeremy L Thompson end 171d102b48SJeremy L Thompson!----------------------------------------------------------------------- 181d102b48SJeremy L Thompson subroutine setup_diff(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,& 191d102b48SJeremy L Thompson& u14,u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,& 201d102b48SJeremy L Thompson& v16,ierr) 211d102b48SJeremy L Thompson real*8 ctx 221d102b48SJeremy L Thompson real*8 u1(1) 231d102b48SJeremy L Thompson real*8 u2(1) 241d102b48SJeremy L Thompson real*8 v1(1) 251d102b48SJeremy L Thompson real*8 w 261d102b48SJeremy L Thompson integer q,ierr 271d102b48SJeremy L Thompson 281d102b48SJeremy L Thompson do i=1,q 291d102b48SJeremy L Thompson w=u2(i)/(u1(i+q*0)*u1(i+q*3)-u1(i+q*1)*u1(i+q*2)) 301d102b48SJeremy L Thompson v1(i+q*0)=w*(u1(i+q*2)*u1(i+q*2)+u1(i+q*3)*u1(i+q*3)) 311d102b48SJeremy L Thompson v1(i+q*1)=w*(u1(i+q*0)*u1(i+q*0)+u1(i+q*1)*u1(i+q*1)) 321d102b48SJeremy L Thompson v1(i+q*2)=-w*(u1(i+q*0)*u1(i+q*2)+u1(i+q*2)*u1(i+q*3)) 331d102b48SJeremy L Thompson enddo 341d102b48SJeremy L Thompson 351d102b48SJeremy L Thompson ierr=0 361d102b48SJeremy L Thompson end 371d102b48SJeremy L Thompson!----------------------------------------------------------------------- 381d102b48SJeremy L Thompson subroutine apply(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,& 391d102b48SJeremy L Thompson& u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,v16,ierr) 401d102b48SJeremy L Thompson real*8 ctx 411d102b48SJeremy L Thompson real*8 u1(1) 421d102b48SJeremy L Thompson real*8 u2(1) 431d102b48SJeremy L Thompson real*8 u3(1) 441d102b48SJeremy L Thompson real*8 u4(1) 451d102b48SJeremy L Thompson real*8 v1(1) 461d102b48SJeremy L Thompson real*8 v2(1) 471d102b48SJeremy L Thompson real*8 du0,du1 481d102b48SJeremy L Thompson integer q,ierr 491d102b48SJeremy L Thompson 501d102b48SJeremy L Thompson do i=1,q 511d102b48SJeremy L Thompson! mass 521d102b48SJeremy L Thompson v1(i) = u2(i)*u4(i) 531d102b48SJeremy L Thompson! diff 541d102b48SJeremy L Thompson du0=u1(i+q*0) 551d102b48SJeremy L Thompson du1=u1(i+q*1) 561d102b48SJeremy L Thompson v2(i+q*0)=u3(i+q*0)*du0+u3(i+q*2)*du1 571d102b48SJeremy L Thompson v2(i+q*1)=u3(i+q*2)*du0+u3(i+q*1)*du1 581d102b48SJeremy L Thompson enddo 591d102b48SJeremy L Thompson 601d102b48SJeremy L Thompson ierr=0 611d102b48SJeremy L Thompson end 621d102b48SJeremy L Thompson!----------------------------------------------------------------------- 631d102b48SJeremy L Thompson subroutine apply_lin(ctx,q,u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,& 641d102b48SJeremy L Thompson& u14,u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,v9,v10,v11,v12,v13,v14,v15,& 651d102b48SJeremy L Thompson& v16,ierr) 661d102b48SJeremy L Thompson real*8 ctx 671d102b48SJeremy L Thompson real*8 u1(1) 681d102b48SJeremy L Thompson real*8 u2(1) 691d102b48SJeremy L Thompson real*8 u3(1) 701d102b48SJeremy L Thompson real*8 v1(1) 711d102b48SJeremy L Thompson real*8 v2(1) 721d102b48SJeremy L Thompson real*8 du0,du1 731d102b48SJeremy L Thompson integer q,ierr 741d102b48SJeremy L Thompson 751d102b48SJeremy L Thompson do i=1,q 761d102b48SJeremy L Thompson du0=u1(i+q*0) 771d102b48SJeremy L Thompson du1=u1(i+q*1) 781d102b48SJeremy L Thompson v1(i+q*0)=u2(i+q*0)*du0+u2(i+q*3)*du1+u2(i+q*6)*u3(i) 791d102b48SJeremy L Thompson v2(i+q*0)=u2(i+q*1)*du0+u2(i+q*4)*du1+u2(i+q*7)*u3(i) 801d102b48SJeremy L Thompson v2(i+q*1)=u2(i+q*2)*du0+u2(i+q*5)*du1+u2(i+q*8)*u3(i) 811d102b48SJeremy L Thompson enddo 821d102b48SJeremy L Thompson 831d102b48SJeremy L Thompson ierr=0 841d102b48SJeremy L Thompson end 851d102b48SJeremy L Thompson!----------------------------------------------------------------------- 861d102b48SJeremy L Thompson program test 871d102b48SJeremy L Thompson 881d102b48SJeremy L Thompson include 'ceedf.h' 891d102b48SJeremy L Thompson 901d102b48SJeremy L Thompson integer ceed,err,i,j,k 9161dbc9d2Sjeremylt integer imode 9261dbc9d2Sjeremylt parameter(imode=ceed_noninterlaced) 93*15910d16Sjeremylt integer stridesu(3),stridesqd(3) 94*15910d16Sjeremylt integer erestrictx,erestrictu,erestrictui 951d102b48SJeremy L Thompson integer erestrictqi,erestrictlini 961d102b48SJeremy L Thompson integer bx,bu 971d102b48SJeremy L Thompson integer qf_setup_mass,qf_setup_diff,qf_apply,qf_apply_lin 981d102b48SJeremy L Thompson integer op_setup_mass,op_setup_diff,op_apply,op_apply_lin 991d102b48SJeremy L Thompson integer qdata_mass,qdata_diff,x,a,u,v 1001d102b48SJeremy L Thompson integer nelem,p,q,d 1011d102b48SJeremy L Thompson integer row,col,offset 1021d102b48SJeremy L Thompson parameter(nelem=6) 1031d102b48SJeremy L Thompson parameter(p=3) 1041d102b48SJeremy L Thompson parameter(q=4) 1051d102b48SJeremy L Thompson parameter(d=2) 1061d102b48SJeremy L Thompson integer ndofs,nqpts,nx,ny 1071d102b48SJeremy L Thompson parameter(nx=3) 1081d102b48SJeremy L Thompson parameter(ny=2) 1091d102b48SJeremy L Thompson parameter(ndofs=(nx*2+1)*(ny*2+1)) 1101d102b48SJeremy L Thompson parameter(nqpts=nelem*q*q) 1111d102b48SJeremy L Thompson integer indx(nelem*p*p) 1121d102b48SJeremy L Thompson real*8 arrx(d*ndofs),vv(ndofs) 1131d102b48SJeremy L Thompson real*8 total 1141d102b48SJeremy L Thompson integer*8 xoffset,voffset 1151d102b48SJeremy L Thompson 1161d102b48SJeremy L Thompson character arg*32 1171d102b48SJeremy L Thompson 1181d102b48SJeremy L Thompson external setup_mass,setup_diff,apply,apply_lin 1191d102b48SJeremy L Thompson 1201d102b48SJeremy L Thompson call getarg(1,arg) 1211d102b48SJeremy L Thompson 1221d102b48SJeremy L Thompson call ceedinit(trim(arg)//char(0),ceed,err) 1231d102b48SJeremy L Thompson 1241d102b48SJeremy L Thompson! DoF Coordinates 1251d102b48SJeremy L Thompson do i=0,nx*2 1261d102b48SJeremy L Thompson do j=0,ny*2 1271d102b48SJeremy L Thompson arrx(i+j*(nx*2+1)+0*ndofs+1)=1.d0*i/(2*nx) 1281d102b48SJeremy L Thompson arrx(i+j*(nx*2+1)+1*ndofs+1)=1.d0*j/(2*ny) 1291d102b48SJeremy L Thompson enddo 1301d102b48SJeremy L Thompson enddo 1311d102b48SJeremy L Thompson call ceedvectorcreate(ceed,d*ndofs,x,err) 1321d102b48SJeremy L Thompson xoffset=0 1331d102b48SJeremy L Thompson call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,arrx,xoffset,err) 1341d102b48SJeremy L Thompson 1351d102b48SJeremy L Thompson! Qdata Vector 1361d102b48SJeremy L Thompson call ceedvectorcreate(ceed,nqpts,qdata_mass,err) 1371d102b48SJeremy L Thompson call ceedvectorcreate(ceed,nqpts*d*(d+1)/2,qdata_diff,err) 1381d102b48SJeremy L Thompson 1391d102b48SJeremy L Thompson! Element Setup 1401d102b48SJeremy L Thompson do i=0,nelem-1 1411d102b48SJeremy L Thompson col=mod(i,nx) 1421d102b48SJeremy L Thompson row=i/nx 1431d102b48SJeremy L Thompson offset=col*(p-1)+row*(nx*2+1)*(p-1) 1441d102b48SJeremy L Thompson do j=0,p-1 1451d102b48SJeremy L Thompson do k=0,p-1 1461d102b48SJeremy L Thompson indx(p*(p*i+k)+j+1)=offset+k*(nx*2+1)+j 1471d102b48SJeremy L Thompson enddo 1481d102b48SJeremy L Thompson enddo 1491d102b48SJeremy L Thompson enddo 1501d102b48SJeremy L Thompson 1511d102b48SJeremy L Thompson! Restrictions 15261dbc9d2Sjeremylt call ceedelemrestrictioncreate(ceed,imode,nelem,p*p,ndofs,d,& 1531d102b48SJeremy L Thompson & ceed_mem_host,ceed_use_pointer,indx,erestrictx,err) 1541d102b48SJeremy L Thompson 15561dbc9d2Sjeremylt call ceedelemrestrictioncreate(ceed,imode,nelem,p*p,ndofs,1,& 1561d102b48SJeremy L Thompson & ceed_mem_host,ceed_use_pointer,indx,erestrictu,err) 1577509a596Sjeremylt stridesu=[1,q*q,q*q] 1587509a596Sjeremylt call ceedelemrestrictioncreatestrided(ceed,nelem,q*q,nqpts,& 1597509a596Sjeremylt & 1,stridesu,erestrictui,err) 1601d102b48SJeremy L Thompson 1617509a596Sjeremylt stridesqd=[1,q*q,q*q*d*(d+1)/2] 1627509a596Sjeremylt call ceedelemrestrictioncreatestrided(ceed,nelem,q*q,nqpts,& 1637509a596Sjeremylt & d*(d+1)/2,stridesqd,erestrictqi,err) 1641d102b48SJeremy L Thompson 1651d102b48SJeremy L Thompson! Bases 1661d102b48SJeremy L Thompson call ceedbasiscreatetensorh1lagrange(ceed,d,d,p,q,ceed_gauss,bx,err) 1671d102b48SJeremy L Thompson call ceedbasiscreatetensorh1lagrange(ceed,d,1,p,q,ceed_gauss,bu,err) 1681d102b48SJeremy L Thompson 1691d102b48SJeremy L Thompson! QFunction - setup mass 1701d102b48SJeremy L Thompson call ceedqfunctioncreateinterior(ceed,1,setup_mass,& 1711d102b48SJeremy L Thompson &SOURCE_DIR& 1721d102b48SJeremy L Thompson &//'t532-operator.h:setup_mass'//char(0),qf_setup_mass,err) 1731d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_setup_mass,'dx',d*d,ceed_eval_grad,err) 1741d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_setup_mass,'_weight',1,ceed_eval_weight,err) 1751d102b48SJeremy L Thompson call ceedqfunctionaddoutput(qf_setup_mass,'qdata',1,ceed_eval_none,err) 1761d102b48SJeremy L Thompson 1771d102b48SJeremy L Thompson! Operator - setup mass 178442e7f0bSjeremylt call ceedoperatorcreate(ceed,qf_setup_mass,ceed_qfunction_none,& 179442e7f0bSjeremylt & ceed_qfunction_none,op_setup_mass,err) 1801d102b48SJeremy L Thompson call ceedoperatorsetfield(op_setup_mass,'dx',erestrictx,& 181a8d32208Sjeremylt & bx,ceed_vector_active,err) 182*15910d16Sjeremylt call ceedoperatorsetfield(op_setup_mass,'_weight',& 183*15910d16Sjeremylt & ceed_elemrestriction_none,bx,ceed_vector_none,err) 1841d102b48SJeremy L Thompson call ceedoperatorsetfield(op_setup_mass,'qdata',erestrictui,& 185a8d32208Sjeremylt & ceed_basis_collocated,ceed_vector_active,err) 1861d102b48SJeremy L Thompson 1871d102b48SJeremy L Thompson! QFunction - setup diff 1881d102b48SJeremy L Thompson call ceedqfunctioncreateinterior(ceed,1,setup_diff,& 1891d102b48SJeremy L Thompson &SOURCE_DIR& 1901d102b48SJeremy L Thompson &//'t532-operator.h:setup_diff'//char(0),qf_setup_diff,err) 1911d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_setup_diff,'dx',d*d,ceed_eval_grad,err) 1921d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_setup_diff,'_weight',1,ceed_eval_weight,err) 1931d102b48SJeremy L Thompson call ceedqfunctionaddoutput(qf_setup_diff,'qdata',& 1941d102b48SJeremy L Thompson & d*(d+1)/2,ceed_eval_none,err) 1951d102b48SJeremy L Thompson 1961d102b48SJeremy L Thompson! Operator - setup diff 197442e7f0bSjeremylt call ceedoperatorcreate(ceed,qf_setup_diff,ceed_qfunction_none,& 198442e7f0bSjeremylt & ceed_qfunction_none,op_setup_diff,err) 1991d102b48SJeremy L Thompson call ceedoperatorsetfield(op_setup_diff,'dx',erestrictx,& 200a8d32208Sjeremylt & bx,ceed_vector_active,err) 201*15910d16Sjeremylt call ceedoperatorsetfield(op_setup_diff,'_weight',& 202*15910d16Sjeremylt & ceed_elemrestriction_none,bx,ceed_vector_none,err) 2031d102b48SJeremy L Thompson call ceedoperatorsetfield(op_setup_diff,'qdata',erestrictqi,& 204a8d32208Sjeremylt & ceed_basis_collocated,ceed_vector_active,err) 2051d102b48SJeremy L Thompson 2061d102b48SJeremy L Thompson! Apply Setup Operators 2071d102b48SJeremy L Thompson call ceedoperatorapply(op_setup_mass,x,qdata_mass,& 2081d102b48SJeremy L Thompson & ceed_request_immediate,err) 2091d102b48SJeremy L Thompson call ceedoperatorapply(op_setup_diff,x,qdata_diff,& 2101d102b48SJeremy L Thompson & ceed_request_immediate,err) 2111d102b48SJeremy L Thompson 2121d102b48SJeremy L Thompson! QFunction - apply 2131d102b48SJeremy L Thompson call ceedqfunctioncreateinterior(ceed,1,apply,& 2141d102b48SJeremy L Thompson &SOURCE_DIR& 2151d102b48SJeremy L Thompson &//'t532-operator.h:apply'//char(0),qf_apply,err) 2161d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply,'du',d,ceed_eval_grad,err) 2171d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply,'qdata_mass',1,ceed_eval_none,err) 2181d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply,'qdata_diff',& 2191d102b48SJeremy L Thompson & d*(d+1)/2,ceed_eval_none,err) 2201d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply,'u',1,ceed_eval_interp,err) 2211d102b48SJeremy L Thompson call ceedqfunctionaddoutput(qf_apply,'v',1,ceed_eval_interp,err) 2221d102b48SJeremy L Thompson call ceedqfunctionaddoutput(qf_apply,'dv',d,ceed_eval_grad,err) 2231d102b48SJeremy L Thompson 2241d102b48SJeremy L Thompson! Operator - apply 225442e7f0bSjeremylt call ceedoperatorcreate(ceed,qf_apply,ceed_qfunction_none,& 226442e7f0bSjeremylt & ceed_qfunction_none,op_apply,err) 2271d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply,'du',erestrictu,& 228a8d32208Sjeremylt & bu,ceed_vector_active,err) 2291d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply,'qdata_mass',erestrictui,& 230a8d32208Sjeremylt & ceed_basis_collocated,qdata_mass,err) 2311d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply,'qdata_diff',erestrictqi,& 232a8d32208Sjeremylt & ceed_basis_collocated,qdata_diff,err) 2331d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply,'u',erestrictu,& 234a8d32208Sjeremylt & bu,ceed_vector_active,err) 2351d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply,'v',erestrictu,& 236a8d32208Sjeremylt & bu,ceed_vector_active,err) 2371d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply,'dv',erestrictu,& 238a8d32208Sjeremylt & bu,ceed_vector_active,err) 2391d102b48SJeremy L Thompson 2401d102b48SJeremy L Thompson! Apply Original Operator 2411d102b48SJeremy L Thompson call ceedvectorcreate(ceed,ndofs,u,err) 2421d102b48SJeremy L Thompson call ceedvectorsetvalue(u,1.d0,err) 2431d102b48SJeremy L Thompson call ceedvectorcreate(ceed,ndofs,v,err) 2441d102b48SJeremy L Thompson call ceedvectorsetvalue(v,0.d0,err) 2451d102b48SJeremy L Thompson call ceedoperatorapply(op_apply,u,v,ceed_request_immediate,err) 2461d102b48SJeremy L Thompson 2471d102b48SJeremy L Thompson! Check Output 2481d102b48SJeremy L Thompson call ceedvectorgetarrayread(v,ceed_mem_host,vv,voffset,err) 2491d102b48SJeremy L Thompson total=0. 2501d102b48SJeremy L Thompson do i=1,ndofs 2511d102b48SJeremy L Thompson total=total+vv(voffset+i) 2521d102b48SJeremy L Thompson enddo 2531d102b48SJeremy L Thompson if (abs(total-1.)>1.0d-10) then 2541d102b48SJeremy L Thompson! LCOV_EXCL_START 2551d102b48SJeremy L Thompson write(*,*) 'Error: True operator computed area = ',total,' != 1.0' 2561d102b48SJeremy L Thompson! LCOV_EXCL_STOP 2571d102b48SJeremy L Thompson endif 2581d102b48SJeremy L Thompson call ceedvectorrestorearrayread(v,vv,voffset,err) 2591d102b48SJeremy L Thompson 2601d102b48SJeremy L Thompson! Assemble QFunction 2611d102b48SJeremy L Thompson call ceedoperatorassemblelinearqfunction(op_apply,a,erestrictlini,& 2621d102b48SJeremy L Thompson & ceed_request_immediate,err) 2631d102b48SJeremy L Thompson 2641d102b48SJeremy L Thompson! QFunction - apply linearized 2651d102b48SJeremy L Thompson call ceedqfunctioncreateinterior(ceed,1,apply_lin,& 2661d102b48SJeremy L Thompson &SOURCE_DIR& 2671d102b48SJeremy L Thompson &//'t532-operator.h:apply_lin'//char(0),qf_apply_lin,err) 2681d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply_lin,'du',d,ceed_eval_grad,err) 2691d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply_lin,'qdata',(d+1)*(d+1),& 2701d102b48SJeremy L Thompson & ceed_eval_none,err) 2711d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply_lin,'u',1,ceed_eval_interp,err) 2721d102b48SJeremy L Thompson call ceedqfunctionaddoutput(qf_apply_lin,'v',1,ceed_eval_interp,err) 2731d102b48SJeremy L Thompson call ceedqfunctionaddoutput(qf_apply_lin,'dv',d,ceed_eval_grad,err) 2741d102b48SJeremy L Thompson 2751d102b48SJeremy L Thompson! Operator - apply linearized 276442e7f0bSjeremylt call ceedoperatorcreate(ceed,qf_apply_lin,ceed_qfunction_none,& 277442e7f0bSjeremylt & ceed_qfunction_none,op_apply_lin,err) 2781d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply_lin,'du',erestrictu,& 279a8d32208Sjeremylt & bu,ceed_vector_active,err) 2801d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply_lin,'qdata',erestrictlini,& 281a8d32208Sjeremylt & ceed_basis_collocated,a,err) 2821d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply_lin,'u',erestrictu,& 283a8d32208Sjeremylt & bu,ceed_vector_active,err) 2841d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply_lin,'v',erestrictu,& 285a8d32208Sjeremylt & bu,ceed_vector_active,err) 2861d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply_lin,'dv',erestrictu,& 287a8d32208Sjeremylt & bu,ceed_vector_active,err) 2881d102b48SJeremy L Thompson 2891d102b48SJeremy L Thompson! Apply Linearized QFunction Operator 2901d102b48SJeremy L Thompson call ceedvectorsetvalue(v,0.d0,err) 2911d102b48SJeremy L Thompson call ceedoperatorapply(op_apply_lin,u,v,ceed_request_immediate,err) 2921d102b48SJeremy L Thompson 2931d102b48SJeremy L Thompson! Check Output 2941d102b48SJeremy L Thompson call ceedvectorgetarrayread(v,ceed_mem_host,vv,voffset,err) 2951d102b48SJeremy L Thompson total=0. 2961d102b48SJeremy L Thompson do i=1,ndofs 2971d102b48SJeremy L Thompson total=total+vv(voffset+i) 2981d102b48SJeremy L Thompson enddo 2991d102b48SJeremy L Thompson if (abs(total-1.)>1.0d-10) then 3001d102b48SJeremy L Thompson! LCOV_EXCL_START 3011d102b48SJeremy L Thompson write(*,*) 'Error: Assembled operator computed area = ',total,' != 1.0' 3021d102b48SJeremy L Thompson! LCOV_EXCL_STOP 3031d102b48SJeremy L Thompson endif 3041d102b48SJeremy L Thompson call ceedvectorrestorearrayread(v,vv,voffset,err) 3051d102b48SJeremy L Thompson 3061d102b48SJeremy L Thompson! Cleanup 3071d102b48SJeremy L Thompson call ceedqfunctiondestroy(qf_setup_mass,err) 3081d102b48SJeremy L Thompson call ceedqfunctiondestroy(qf_setup_diff,err) 3091d102b48SJeremy L Thompson call ceedqfunctiondestroy(qf_apply,err) 3101d102b48SJeremy L Thompson call ceedqfunctiondestroy(qf_apply_lin,err) 3111d102b48SJeremy L Thompson call ceedoperatordestroy(op_setup_mass,err) 3121d102b48SJeremy L Thompson call ceedoperatordestroy(op_setup_diff,err) 3131d102b48SJeremy L Thompson call ceedoperatordestroy(op_apply,err) 3141d102b48SJeremy L Thompson call ceedoperatordestroy(op_apply_lin,err) 3151d102b48SJeremy L Thompson call ceedelemrestrictiondestroy(erestrictu,err) 3161d102b48SJeremy L Thompson call ceedelemrestrictiondestroy(erestrictx,err) 3171d102b48SJeremy L Thompson call ceedelemrestrictiondestroy(erestrictui,err) 3181d102b48SJeremy L Thompson call ceedelemrestrictiondestroy(erestrictqi,err) 3191d102b48SJeremy L Thompson call ceedelemrestrictiondestroy(erestrictlini,err) 3201d102b48SJeremy L Thompson call ceedbasisdestroy(bu,err) 3211d102b48SJeremy L Thompson call ceedbasisdestroy(bx,err) 3221d102b48SJeremy L Thompson call ceedvectordestroy(x,err) 3231d102b48SJeremy L Thompson call ceedvectordestroy(a,err) 3241d102b48SJeremy L Thompson call ceedvectordestroy(u,err) 3251d102b48SJeremy L Thompson call ceedvectordestroy(v,err) 3261d102b48SJeremy L Thompson call ceedvectordestroy(qdata_mass,err) 3271d102b48SJeremy L Thompson call ceedvectordestroy(qdata_diff,err) 3281d102b48SJeremy L Thompson call ceeddestroy(ceed,err) 3291d102b48SJeremy L Thompson end 3301d102b48SJeremy L Thompson!----------------------------------------------------------------------- 331