12ebaca42Sjeremylt!----------------------------------------------------------------------- 2752c3701SJeremy L Thompson! 3752c3701SJeremy L Thompson! Header with QFunctions 4752c3701SJeremy L Thompson! 5752c3701SJeremy L Thompson include 't500-operator-f.h' 62ebaca42Sjeremylt!----------------------------------------------------------------------- 72ebaca42Sjeremylt program test 81f9a83abSJed Brown implicit none 9ec3da8bcSJed Brown include 'ceed/fortran.h' 102ebaca42Sjeremylt 112ebaca42Sjeremylt integer ceed,err,i,j 1215910d16Sjeremylt integer stridesu(3) 1315910d16Sjeremylt integer erestrictx,erestrictu,erestrictui 142ebaca42Sjeremylt integer bx,bu 152ebaca42Sjeremylt integer qf_setup,qf_mass 162ebaca42Sjeremylt integer op_setup,op_mass 171f9a83abSJed Brown integer x,qdata 182ebaca42Sjeremylt integer nelem,p,q 192ebaca42Sjeremylt parameter(nelem=15) 202ebaca42Sjeremylt parameter(p=5) 212ebaca42Sjeremylt parameter(q=8) 222ebaca42Sjeremylt integer nx,nu 232ebaca42Sjeremylt parameter(nx=nelem+1) 242ebaca42Sjeremylt parameter(nu=nelem*(p-1)+1) 252ebaca42Sjeremylt integer indx(nelem*2) 262ebaca42Sjeremylt integer indu(nelem*p) 272ebaca42Sjeremylt 282ebaca42Sjeremylt character arg*32 292ebaca42Sjeremylt 30f1a4e9feSjeremylt! LCOV_EXCL_START 312ebaca42Sjeremylt external setup,mass 32f1a4e9feSjeremylt! LCOV_EXCL_STOP 332ebaca42Sjeremylt 342ebaca42Sjeremylt call getarg(1,arg) 352ebaca42Sjeremylt call ceedinit(trim(arg)//char(0),ceed,err) 362ebaca42Sjeremylt 372ebaca42Sjeremylt do i=0,nelem-1 382ebaca42Sjeremylt indx(2*i+1)=i 392ebaca42Sjeremylt indx(2*i+2)=i+1 402ebaca42Sjeremylt enddo 412ebaca42Sjeremylt 42d979a051Sjeremylt call ceedelemrestrictioncreate(ceed,nelem,2,1,1,nx,ceed_mem_host,& 432ebaca42Sjeremylt & ceed_use_pointer,indx,erestrictx,err) 442ebaca42Sjeremylt 452ebaca42Sjeremylt do i=0,nelem-1 462ebaca42Sjeremylt do j=0,p-1 47d979a051Sjeremylt indu(p*i+j+1)=2*(i*(p-1)+j) 482ebaca42Sjeremylt enddo 492ebaca42Sjeremylt enddo 502ebaca42Sjeremylt 51d979a051Sjeremylt call ceedelemrestrictioncreate(ceed,nelem,p,2,1,2*nu,ceed_mem_host,& 522ebaca42Sjeremylt & ceed_use_pointer,indu,erestrictu,err) 537509a596Sjeremylt stridesu=[1,q,q] 54d979a051Sjeremylt call ceedelemrestrictioncreatestrided(ceed,nelem,q,1,q*nelem,stridesu,& 552ebaca42Sjeremylt & erestrictui,err) 562ebaca42Sjeremylt 572ebaca42Sjeremylt call ceedbasiscreatetensorh1lagrange(ceed,1,1,2,q,ceed_gauss,bx,err) 58d979a051Sjeremylt call ceedbasiscreatetensorh1lagrange(ceed,1,2,p,q,ceed_gauss,bu,err) 592ebaca42Sjeremylt 602ebaca42Sjeremylt call ceedqfunctioncreateinterior(ceed,1,setup,& 612ebaca42Sjeremylt &SOURCE_DIR& 622ebaca42Sjeremylt &//'t500-operator.h:setup'//char(0),qf_setup,err) 63a61c78d6SJeremy L Thompson call ceedqfunctionaddinput(qf_setup,'weight',1,ceed_eval_weight,err) 642ebaca42Sjeremylt call ceedqfunctionaddinput(qf_setup,'dx',1,ceed_eval_grad,err) 652ebaca42Sjeremylt call ceedqfunctionaddoutput(qf_setup,'rho',1,ceed_eval_none,err) 662ebaca42Sjeremylt 672ebaca42Sjeremylt call ceedqfunctioncreateinterior(ceed,1,mass,& 682ebaca42Sjeremylt &SOURCE_DIR& 692ebaca42Sjeremylt &//'t500-operator.h:mass'//char(0),qf_mass,err) 702ebaca42Sjeremylt call ceedqfunctionaddinput(qf_mass,'rho',1,ceed_eval_none,err) 71d979a051Sjeremylt call ceedqfunctionaddinput(qf_mass,'u',2,ceed_eval_interp,err) 72d979a051Sjeremylt call ceedqfunctionaddoutput(qf_mass,'v',2,ceed_eval_interp,err) 732ebaca42Sjeremylt 742ebaca42Sjeremylt call ceedoperatorcreate(ceed,qf_setup,ceed_qfunction_none,& 752ebaca42Sjeremylt & ceed_qfunction_none,op_setup,err) 762ebaca42Sjeremylt call ceedoperatorcreate(ceed,qf_mass,ceed_qfunction_none,& 772ebaca42Sjeremylt & ceed_qfunction_none,op_mass,err) 782ebaca42Sjeremylt 792ebaca42Sjeremylt call ceedvectorcreate(ceed,nx,x,err) 802ebaca42Sjeremylt call ceedvectorcreate(ceed,nelem*q,qdata,err) 812ebaca42Sjeremylt 82a61c78d6SJeremy L Thompson call ceedoperatorsetfield(op_setup,'weight',ceed_elemrestriction_none,& 8315910d16Sjeremylt & bx,ceed_vector_none,err) 84a8d32208Sjeremylt call ceedoperatorsetfield(op_setup,'dx',erestrictx,bx,& 85a8d32208Sjeremylt & ceed_vector_active,err) 862ebaca42Sjeremylt call ceedoperatorsetfield(op_setup,'rho',erestrictui,& 87356036faSJeremy L Thompson ceed_basis_none,ceed_vector_active,err) 882ebaca42Sjeremylt call ceedoperatorsetfield(op_mass,'rho',erestrictui,& 89356036faSJeremy L Thompson ceed_basis_none,qdata,err) 90a8d32208Sjeremylt call ceedoperatorsetfield(op_mass,'u',erestrictu,bu,& 91a8d32208Sjeremylt & ceed_vector_active,err) 92a8d32208Sjeremylt call ceedoperatorsetfield(op_mass,'v',erestrictu,bu,& 93a8d32208Sjeremylt & ceed_vector_active,err) 942ebaca42Sjeremylt 95935f026aSJeremy L Thompson call ceedoperatorsetname(op_setup,'setup',err) 962ebaca42Sjeremylt call ceedoperatorview(op_setup,err) 97935f026aSJeremy L Thompson call ceedoperatorsetname(op_mass,'mass',err) 98*5a526491SJeremy L Thompson call ceedoperatorsetnumviewtabs(op_mass,1,err) 992ebaca42Sjeremylt call ceedoperatorview(op_mass,err) 1002ebaca42Sjeremylt 1012ebaca42Sjeremylt call ceedvectordestroy(qdata,err) 1022ebaca42Sjeremylt call ceedoperatordestroy(op_mass,err) 1032ebaca42Sjeremylt call ceedoperatordestroy(op_setup,err) 1042ebaca42Sjeremylt call ceedqfunctiondestroy(qf_mass,err) 1052ebaca42Sjeremylt call ceedqfunctiondestroy(qf_setup,err) 1062ebaca42Sjeremylt call ceedbasisdestroy(bu,err) 1072ebaca42Sjeremylt call ceedbasisdestroy(bx,err) 1082ebaca42Sjeremylt call ceedelemrestrictiondestroy(erestrictu,err) 1092ebaca42Sjeremylt call ceedelemrestrictiondestroy(erestrictx,err) 1102ebaca42Sjeremylt call ceedelemrestrictiondestroy(erestrictui,err) 1112ebaca42Sjeremylt call ceeddestroy(ceed,err) 1122ebaca42Sjeremylt end 1132ebaca42Sjeremylt!----------------------------------------------------------------------- 114