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 911d102b48SJeremy L Thompson integer erestrictx,erestrictu,erestrictxi,erestrictui 921d102b48SJeremy L Thompson integer erestrictqi,erestrictlini 931d102b48SJeremy L Thompson integer bx,bu 941d102b48SJeremy L Thompson integer qf_setup_mass,qf_setup_diff,qf_apply,qf_apply_lin 951d102b48SJeremy L Thompson integer op_setup_mass,op_setup_diff,op_apply,op_apply_lin 961d102b48SJeremy L Thompson integer qdata_mass,qdata_diff,x,a,u,v 971d102b48SJeremy L Thompson integer nelem,p,q,d 981d102b48SJeremy L Thompson integer row,col,offset 991d102b48SJeremy L Thompson parameter(nelem=6) 1001d102b48SJeremy L Thompson parameter(p=3) 1011d102b48SJeremy L Thompson parameter(q=4) 1021d102b48SJeremy L Thompson parameter(d=2) 1031d102b48SJeremy L Thompson integer ndofs,nqpts,nx,ny 1041d102b48SJeremy L Thompson parameter(nx=3) 1051d102b48SJeremy L Thompson parameter(ny=2) 1061d102b48SJeremy L Thompson parameter(ndofs=(nx*2+1)*(ny*2+1)) 1071d102b48SJeremy L Thompson parameter(nqpts=nelem*q*q) 1081d102b48SJeremy L Thompson integer indx(nelem*p*p) 1091d102b48SJeremy L Thompson real*8 arrx(d*ndofs),vv(ndofs) 1101d102b48SJeremy L Thompson real*8 total 1111d102b48SJeremy L Thompson integer*8 xoffset,voffset 1121d102b48SJeremy L Thompson 1131d102b48SJeremy L Thompson character arg*32 1141d102b48SJeremy L Thompson 1151d102b48SJeremy L Thompson external setup_mass,setup_diff,apply,apply_lin 1161d102b48SJeremy L Thompson 1171d102b48SJeremy L Thompson call getarg(1,arg) 1181d102b48SJeremy L Thompson 1191d102b48SJeremy L Thompson call ceedinit(trim(arg)//char(0),ceed,err) 1201d102b48SJeremy L Thompson 1211d102b48SJeremy L Thompson! DoF Coordinates 1221d102b48SJeremy L Thompson do i=0,nx*2 1231d102b48SJeremy L Thompson do j=0,ny*2 1241d102b48SJeremy L Thompson arrx(i+j*(nx*2+1)+0*ndofs+1)=1.d0*i/(2*nx) 1251d102b48SJeremy L Thompson arrx(i+j*(nx*2+1)+1*ndofs+1)=1.d0*j/(2*ny) 1261d102b48SJeremy L Thompson enddo 1271d102b48SJeremy L Thompson enddo 1281d102b48SJeremy L Thompson call ceedvectorcreate(ceed,d*ndofs,x,err) 1291d102b48SJeremy L Thompson xoffset=0 1301d102b48SJeremy L Thompson call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,arrx,xoffset,err) 1311d102b48SJeremy L Thompson 1321d102b48SJeremy L Thompson! Qdata Vector 1331d102b48SJeremy L Thompson call ceedvectorcreate(ceed,nqpts,qdata_mass,err) 1341d102b48SJeremy L Thompson call ceedvectorcreate(ceed,nqpts*d*(d+1)/2,qdata_diff,err) 1351d102b48SJeremy L Thompson 1361d102b48SJeremy L Thompson! Element Setup 1371d102b48SJeremy L Thompson do i=0,nelem-1 1381d102b48SJeremy L Thompson col=mod(i,nx) 1391d102b48SJeremy L Thompson row=i/nx 1401d102b48SJeremy L Thompson offset=col*(p-1)+row*(nx*2+1)*(p-1) 1411d102b48SJeremy L Thompson do j=0,p-1 1421d102b48SJeremy L Thompson do k=0,p-1 1431d102b48SJeremy L Thompson indx(p*(p*i+k)+j+1)=offset+k*(nx*2+1)+j 1441d102b48SJeremy L Thompson enddo 1451d102b48SJeremy L Thompson enddo 1461d102b48SJeremy L Thompson enddo 1471d102b48SJeremy L Thompson 1481d102b48SJeremy L Thompson! Restrictions 1491d102b48SJeremy L Thompson call ceedelemrestrictioncreate(ceed,nelem,p*p,ndofs,d,& 1501d102b48SJeremy L Thompson & ceed_mem_host,ceed_use_pointer,indx,erestrictx,err) 1511d102b48SJeremy L Thompson call ceedelemrestrictioncreateidentity(ceed,nelem,p*p,& 1521d102b48SJeremy L Thompson & nelem*p*p,d,erestrictxi,err) 1531d102b48SJeremy L Thompson 1541d102b48SJeremy L Thompson call ceedelemrestrictioncreate(ceed,nelem,p*p,ndofs,1,& 1551d102b48SJeremy L Thompson & ceed_mem_host,ceed_use_pointer,indx,erestrictu,err) 1561d102b48SJeremy L Thompson call ceedelemrestrictioncreateidentity(ceed,nelem,q*q,nqpts,& 1571d102b48SJeremy L Thompson & 1,erestrictui,err) 1581d102b48SJeremy L Thompson 1591d102b48SJeremy L Thompson call ceedelemrestrictioncreateidentity(ceed,nelem,q*q,nqpts,& 1601d102b48SJeremy L Thompson & d*(d+1)/2,erestrictqi,err) 1611d102b48SJeremy L Thompson 1621d102b48SJeremy L Thompson! Bases 1631d102b48SJeremy L Thompson call ceedbasiscreatetensorh1lagrange(ceed,d,d,p,q,ceed_gauss,bx,err) 1641d102b48SJeremy L Thompson call ceedbasiscreatetensorh1lagrange(ceed,d,1,p,q,ceed_gauss,bu,err) 1651d102b48SJeremy L Thompson 1661d102b48SJeremy L Thompson! QFunction - setup mass 1671d102b48SJeremy L Thompson call ceedqfunctioncreateinterior(ceed,1,setup_mass,& 1681d102b48SJeremy L Thompson &SOURCE_DIR& 1691d102b48SJeremy L Thompson &//'t532-operator.h:setup_mass'//char(0),qf_setup_mass,err) 1701d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_setup_mass,'dx',d*d,ceed_eval_grad,err) 1711d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_setup_mass,'_weight',1,ceed_eval_weight,err) 1721d102b48SJeremy L Thompson call ceedqfunctionaddoutput(qf_setup_mass,'qdata',1,ceed_eval_none,err) 1731d102b48SJeremy L Thompson 1741d102b48SJeremy L Thompson! Operator - setup mass 175*442e7f0bSjeremylt call ceedoperatorcreate(ceed,qf_setup_mass,ceed_qfunction_none,& 176*442e7f0bSjeremylt & ceed_qfunction_none,op_setup_mass,err) 1771d102b48SJeremy L Thompson call ceedoperatorsetfield(op_setup_mass,'dx',erestrictx,& 1781d102b48SJeremy L Thompson & ceed_notranspose,bx,ceed_vector_active,err) 1791d102b48SJeremy L Thompson call ceedoperatorsetfield(op_setup_mass,'_weight',erestrictxi,& 1801d102b48SJeremy L Thompson & ceed_notranspose,bx,ceed_vector_none,err) 1811d102b48SJeremy L Thompson call ceedoperatorsetfield(op_setup_mass,'qdata',erestrictui,& 1821d102b48SJeremy L Thompson & ceed_notranspose,ceed_basis_collocated,ceed_vector_active,err) 1831d102b48SJeremy L Thompson 1841d102b48SJeremy L Thompson! QFunction - setup diff 1851d102b48SJeremy L Thompson call ceedqfunctioncreateinterior(ceed,1,setup_diff,& 1861d102b48SJeremy L Thompson &SOURCE_DIR& 1871d102b48SJeremy L Thompson &//'t532-operator.h:setup_diff'//char(0),qf_setup_diff,err) 1881d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_setup_diff,'dx',d*d,ceed_eval_grad,err) 1891d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_setup_diff,'_weight',1,ceed_eval_weight,err) 1901d102b48SJeremy L Thompson call ceedqfunctionaddoutput(qf_setup_diff,'qdata',& 1911d102b48SJeremy L Thompson & d*(d+1)/2,ceed_eval_none,err) 1921d102b48SJeremy L Thompson 1931d102b48SJeremy L Thompson! Operator - setup diff 194*442e7f0bSjeremylt call ceedoperatorcreate(ceed,qf_setup_diff,ceed_qfunction_none,& 195*442e7f0bSjeremylt & ceed_qfunction_none,op_setup_diff,err) 1961d102b48SJeremy L Thompson call ceedoperatorsetfield(op_setup_diff,'dx',erestrictx,& 1971d102b48SJeremy L Thompson & ceed_notranspose,bx,ceed_vector_active,err) 1981d102b48SJeremy L Thompson call ceedoperatorsetfield(op_setup_diff,'_weight',erestrictxi,& 1991d102b48SJeremy L Thompson & ceed_notranspose,bx,ceed_vector_none,err) 2001d102b48SJeremy L Thompson call ceedoperatorsetfield(op_setup_diff,'qdata',erestrictqi,& 2011d102b48SJeremy L Thompson & ceed_notranspose,ceed_basis_collocated,ceed_vector_active,err) 2021d102b48SJeremy L Thompson 2031d102b48SJeremy L Thompson! Apply Setup Operators 2041d102b48SJeremy L Thompson call ceedoperatorapply(op_setup_mass,x,qdata_mass,& 2051d102b48SJeremy L Thompson & ceed_request_immediate,err) 2061d102b48SJeremy L Thompson call ceedoperatorapply(op_setup_diff,x,qdata_diff,& 2071d102b48SJeremy L Thompson & ceed_request_immediate,err) 2081d102b48SJeremy L Thompson 2091d102b48SJeremy L Thompson! QFunction - apply 2101d102b48SJeremy L Thompson call ceedqfunctioncreateinterior(ceed,1,apply,& 2111d102b48SJeremy L Thompson &SOURCE_DIR& 2121d102b48SJeremy L Thompson &//'t532-operator.h:apply'//char(0),qf_apply,err) 2131d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply,'du',d,ceed_eval_grad,err) 2141d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply,'qdata_mass',1,ceed_eval_none,err) 2151d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply,'qdata_diff',& 2161d102b48SJeremy L Thompson & d*(d+1)/2,ceed_eval_none,err) 2171d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply,'u',1,ceed_eval_interp,err) 2181d102b48SJeremy L Thompson call ceedqfunctionaddoutput(qf_apply,'v',1,ceed_eval_interp,err) 2191d102b48SJeremy L Thompson call ceedqfunctionaddoutput(qf_apply,'dv',d,ceed_eval_grad,err) 2201d102b48SJeremy L Thompson 2211d102b48SJeremy L Thompson! Operator - apply 222*442e7f0bSjeremylt call ceedoperatorcreate(ceed,qf_apply,ceed_qfunction_none,& 223*442e7f0bSjeremylt & ceed_qfunction_none,op_apply,err) 2241d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply,'du',erestrictu,& 2251d102b48SJeremy L Thompson & ceed_notranspose,bu,ceed_vector_active,err) 2261d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply,'qdata_mass',erestrictui,& 2271d102b48SJeremy L Thompson & ceed_notranspose,ceed_basis_collocated,qdata_mass,err) 2281d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply,'qdata_diff',erestrictqi,& 2291d102b48SJeremy L Thompson & ceed_notranspose,ceed_basis_collocated,qdata_diff,err) 2301d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply,'u',erestrictu,& 2311d102b48SJeremy L Thompson & ceed_notranspose,bu,ceed_vector_active,err) 2321d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply,'v',erestrictu,& 2331d102b48SJeremy L Thompson & ceed_notranspose,bu,ceed_vector_active,err) 2341d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply,'dv',erestrictu,& 2351d102b48SJeremy L Thompson & ceed_notranspose,bu,ceed_vector_active,err) 2361d102b48SJeremy L Thompson 2371d102b48SJeremy L Thompson! Apply Original Operator 2381d102b48SJeremy L Thompson call ceedvectorcreate(ceed,ndofs,u,err) 2391d102b48SJeremy L Thompson call ceedvectorsetvalue(u,1.d0,err) 2401d102b48SJeremy L Thompson call ceedvectorcreate(ceed,ndofs,v,err) 2411d102b48SJeremy L Thompson call ceedvectorsetvalue(v,0.d0,err) 2421d102b48SJeremy L Thompson call ceedoperatorapply(op_apply,u,v,ceed_request_immediate,err) 2431d102b48SJeremy L Thompson 2441d102b48SJeremy L Thompson! Check Output 2451d102b48SJeremy L Thompson call ceedvectorgetarrayread(v,ceed_mem_host,vv,voffset,err) 2461d102b48SJeremy L Thompson total=0. 2471d102b48SJeremy L Thompson do i=1,ndofs 2481d102b48SJeremy L Thompson total=total+vv(voffset+i) 2491d102b48SJeremy L Thompson enddo 2501d102b48SJeremy L Thompson if (abs(total-1.)>1.0d-10) then 2511d102b48SJeremy L Thompson! LCOV_EXCL_START 2521d102b48SJeremy L Thompson write(*,*) 'Error: True operator computed area = ',total,' != 1.0' 2531d102b48SJeremy L Thompson! LCOV_EXCL_STOP 2541d102b48SJeremy L Thompson endif 2551d102b48SJeremy L Thompson call ceedvectorrestorearrayread(v,vv,voffset,err) 2561d102b48SJeremy L Thompson 2571d102b48SJeremy L Thompson! Assemble QFunction 2581d102b48SJeremy L Thompson call ceedoperatorassemblelinearqfunction(op_apply,a,erestrictlini,& 2591d102b48SJeremy L Thompson & ceed_request_immediate,err) 2601d102b48SJeremy L Thompson 2611d102b48SJeremy L Thompson! QFunction - apply linearized 2621d102b48SJeremy L Thompson call ceedqfunctioncreateinterior(ceed,1,apply_lin,& 2631d102b48SJeremy L Thompson &SOURCE_DIR& 2641d102b48SJeremy L Thompson &//'t532-operator.h:apply_lin'//char(0),qf_apply_lin,err) 2651d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply_lin,'du',d,ceed_eval_grad,err) 2661d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply_lin,'qdata',(d+1)*(d+1),& 2671d102b48SJeremy L Thompson & ceed_eval_none,err) 2681d102b48SJeremy L Thompson call ceedqfunctionaddinput(qf_apply_lin,'u',1,ceed_eval_interp,err) 2691d102b48SJeremy L Thompson call ceedqfunctionaddoutput(qf_apply_lin,'v',1,ceed_eval_interp,err) 2701d102b48SJeremy L Thompson call ceedqfunctionaddoutput(qf_apply_lin,'dv',d,ceed_eval_grad,err) 2711d102b48SJeremy L Thompson 2721d102b48SJeremy L Thompson! Operator - apply linearized 273*442e7f0bSjeremylt call ceedoperatorcreate(ceed,qf_apply_lin,ceed_qfunction_none,& 274*442e7f0bSjeremylt & ceed_qfunction_none,op_apply_lin,err) 2751d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply_lin,'du',erestrictu,& 2761d102b48SJeremy L Thompson & ceed_notranspose,bu,ceed_vector_active,err) 2771d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply_lin,'qdata',erestrictlini,& 2781d102b48SJeremy L Thompson & ceed_notranspose,ceed_basis_collocated,a,err) 2791d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply_lin,'u',erestrictu,& 2801d102b48SJeremy L Thompson & ceed_notranspose,bu,ceed_vector_active,err) 2811d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply_lin,'v',erestrictu,& 2821d102b48SJeremy L Thompson & ceed_notranspose,bu,ceed_vector_active,err) 2831d102b48SJeremy L Thompson call ceedoperatorsetfield(op_apply_lin,'dv',erestrictu,& 2841d102b48SJeremy L Thompson & ceed_notranspose,bu,ceed_vector_active,err) 2851d102b48SJeremy L Thompson 2861d102b48SJeremy L Thompson! Apply Linearized QFunction Operator 2871d102b48SJeremy L Thompson call ceedvectorsetvalue(v,0.d0,err) 2881d102b48SJeremy L Thompson call ceedoperatorapply(op_apply_lin,u,v,ceed_request_immediate,err) 2891d102b48SJeremy L Thompson 2901d102b48SJeremy L Thompson! Check Output 2911d102b48SJeremy L Thompson call ceedvectorgetarrayread(v,ceed_mem_host,vv,voffset,err) 2921d102b48SJeremy L Thompson total=0. 2931d102b48SJeremy L Thompson do i=1,ndofs 2941d102b48SJeremy L Thompson total=total+vv(voffset+i) 2951d102b48SJeremy L Thompson enddo 2961d102b48SJeremy L Thompson if (abs(total-1.)>1.0d-10) then 2971d102b48SJeremy L Thompson! LCOV_EXCL_START 2981d102b48SJeremy L Thompson write(*,*) 'Error: Assembled operator computed area = ',total,' != 1.0' 2991d102b48SJeremy L Thompson! LCOV_EXCL_STOP 3001d102b48SJeremy L Thompson endif 3011d102b48SJeremy L Thompson call ceedvectorrestorearrayread(v,vv,voffset,err) 3021d102b48SJeremy L Thompson 3031d102b48SJeremy L Thompson! Cleanup 3041d102b48SJeremy L Thompson call ceedqfunctiondestroy(qf_setup_mass,err) 3051d102b48SJeremy L Thompson call ceedqfunctiondestroy(qf_setup_diff,err) 3061d102b48SJeremy L Thompson call ceedqfunctiondestroy(qf_apply,err) 3071d102b48SJeremy L Thompson call ceedqfunctiondestroy(qf_apply_lin,err) 3081d102b48SJeremy L Thompson call ceedoperatordestroy(op_setup_mass,err) 3091d102b48SJeremy L Thompson call ceedoperatordestroy(op_setup_diff,err) 3101d102b48SJeremy L Thompson call ceedoperatordestroy(op_apply,err) 3111d102b48SJeremy L Thompson call ceedoperatordestroy(op_apply_lin,err) 3121d102b48SJeremy L Thompson call ceedelemrestrictiondestroy(erestrictu,err) 3131d102b48SJeremy L Thompson call ceedelemrestrictiondestroy(erestrictx,err) 3141d102b48SJeremy L Thompson call ceedelemrestrictiondestroy(erestrictxi,err) 3151d102b48SJeremy L Thompson call ceedelemrestrictiondestroy(erestrictui,err) 3161d102b48SJeremy L Thompson call ceedelemrestrictiondestroy(erestrictqi,err) 3171d102b48SJeremy L Thompson call ceedelemrestrictiondestroy(erestrictlini,err) 3181d102b48SJeremy L Thompson call ceedbasisdestroy(bu,err) 3191d102b48SJeremy L Thompson call ceedbasisdestroy(bx,err) 3201d102b48SJeremy L Thompson call ceedvectordestroy(x,err) 3211d102b48SJeremy L Thompson call ceedvectordestroy(a,err) 3221d102b48SJeremy L Thompson call ceedvectordestroy(u,err) 3231d102b48SJeremy L Thompson call ceedvectordestroy(v,err) 3241d102b48SJeremy L Thompson call ceedvectordestroy(qdata_mass,err) 3251d102b48SJeremy L Thompson call ceedvectordestroy(qdata_diff,err) 3261d102b48SJeremy L Thompson call ceeddestroy(ceed,err) 3271d102b48SJeremy L Thompson end 3281d102b48SJeremy L Thompson!----------------------------------------------------------------------- 329